Routine PDLARZB() Documented By Universal Report

Routine: PDLARZB()

# lines:	612
# code:	612
# comment:	0
# blank:	0
# Variables:	85
# Callers:	2
# Callings:	0
# Words:	317
# Keywords:	178

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PDLARZB applies a real block reflector Q or its transpose Q**T to
  a real distributed M-by-N matrix sub( C ) = C(IC:IC+M-1,JC:JC+N-1)
  from the left or the right.
  Q is a product of k elementary reflectors as returned by PDTZRZF.
  Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
  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
  =========
  SIDE    (global input) CHARACTER
          = 'L': apply Q or Q**T from the Left;
          = 'R': apply Q or Q**T from the Right.
  TRANS   (global input) CHARACTER
          = 'N':  No transpose, apply Q;
          = 'T':  Transpose, apply Q**T.
  DIRECT  (global input) CHARACTER
          Indicates how H is formed from a product of elementary
          reflectors
          = 'F': H = H(1) H(2) . . . H(k) (Forward, not supported yet)
          = 'B': H = H(k) . . . H(2) H(1) (Backward)
  STOREV  (global input) CHARACTER
          Indicates how the vectors which define the elementary
          reflectors are stored:
          = 'C': Columnwise                        (not supported yet)
          = 'R': Rowwise
  M       (global input) INTEGER
          The number of rows to be operated on i.e the number of rows
          of the distributed submatrix sub( C ). M >= 0.
  N       (global input) INTEGER
          The number of columns to be operated on i.e the number of
          columns of the distributed submatrix sub( C ). N >= 0.
  K       (global input) INTEGER
          The order of the matrix T (= the number of elementary
          reflectors whose product defines the block reflector).
  L       (global input) INTEGER
          The columns of the distributed submatrix sub( A ) containing
          the meaningful part of the Householder reflectors.
          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
  V       (local input) DOUBLE PRECISION pointer into the local memory
          to an array of dimension (LLD_V, LOCc(JV+M-1)) if SIDE = 'L',
          (LLD_V, LOCc(JV+N-1)) if SIDE = 'R'. It contains the local
          pieces of the distributed vectors V representing the
          Householder transformation as returned by PDTZRZF.
          LLD_V >= LOCr(IV+K-1).
  IV      (global input) INTEGER
          The row index in the global array V indicating the first
          row of sub( V ).
  JV      (global input) INTEGER
          The column index in the global array V indicating the
          first column of sub( V ).
  DESCV   (global and local input) INTEGER array of dimension DLEN_.
          The array descriptor for the distributed matrix V.
  T       (local input) DOUBLE PRECISION array, dimension MB_V by MB_V
          The lower triangular matrix T in the representation of the
          block reflector.
  C       (local input/local output) DOUBLE PRECISION pointer into the
          local memory to an array of dimension (LLD_C,LOCc(JC+N-1)).
          On entry, the M-by-N distributed matrix sub( C ). On exit,
          sub( C ) is overwritten by Q*sub( C ) or Q'*sub( C ) or
          sub( C )*Q or sub( C )*Q'.
  IC      (global input) INTEGER
          The row index in the global array C indicating the first
          row of sub( C ).
  JC      (global input) INTEGER
          The column index in the global array C indicating the
          first column of sub( C ).
  DESCC   (global and local input) INTEGER array of dimension DLEN_.
          The array descriptor for the distributed matrix C.
  WORK    (local workspace) DOUBLE PRECISION array, dimension (LWORK)
          If STOREV = 'C',
            if SIDE = 'L',
              LWORK >= ( NqC0 + MpC0 ) * K
            else if SIDE = 'R',
              LWORK >= ( NqC0 + MAX( NpV0 + NUMROC( NUMROC( N+ICOFFC,
                         NB_V, 0, 0, NPCOL ), NB_V, 0, 0, LCMQ ),
                         MpC0 ) ) * K
            end if
          else if STOREV = 'R',
            if SIDE = 'L',
              LWORK >= ( MpC0 + MAX( MqV0 + NUMROC( NUMROC( M+IROFFC,
                         MB_V, 0, 0, NPROW ), MB_V, 0, 0, LCMP ),
                         NqC0 ) ) * K
            else if SIDE = 'R',
              LWORK >= ( MpC0 + NqC0 ) * K
            end if
          end if
          where LCMQ = LCM / NPCOL with LCM = ICLM( NPROW, NPCOL ),
          IROFFV = MOD( IV-1, MB_V ), ICOFFV = MOD( JV-1, NB_V ),
          IVROW = INDXG2P( IV, MB_V, MYROW, RSRC_V, NPROW ),
          IVCOL = INDXG2P( JV, NB_V, MYCOL, CSRC_V, NPCOL ),
          MqV0 = NUMROC( M+ICOFFV, NB_V, MYCOL, IVCOL, NPCOL ),
          NpV0 = NUMROC( N+IROFFV, MB_V, MYROW, IVROW, NPROW ),
          IROFFC = MOD( IC-1, MB_C ), ICOFFC = MOD( JC-1, NB_C ),
          ICROW = INDXG2P( IC, MB_C, MYROW, RSRC_C, NPROW ),
          ICCOL = INDXG2P( JC, NB_C, MYCOL, CSRC_C, NPCOL ),
          MpC0 = NUMROC( M+IROFFC, MB_C, MYROW, ICROW, NPROW ),
          NpC0 = NUMROC( N+ICOFFC, MB_C, MYROW, ICROW, NPROW ),
          NqC0 = NUMROC( N+ICOFFC, NB_C, MYCOL, ICCOL, NPCOL ),
          ILCM, INDXG2P and NUMROC are ScaLAPACK tool functions;
          MYROW, MYCOL, NPROW and NPCOL can be determined by calling
          the subroutine BLACS_GRIDINFO.
  Alignment requirements
  ======================
  The distributed submatrices V(IV:*, JV:*) and C(IC:IC+M-1,JC:JC+N-1)
  must verify some alignment properties, namely the following
  expressions should be true:
  If STOREV = 'Columnwise'
    If SIDE = 'Left',
      ( MB_V.EQ.MB_C .AND. IROFFV.EQ.IROFFC .AND. IVROW.EQ.ICROW )
    If SIDE = 'Right',
      ( MB_V.EQ.NB_C .AND. IROFFV.EQ.ICOFFC )
  else if STOREV = 'Rowwise'
    If SIDE = 'Left',
      ( NB_V.EQ.MB_C .AND. ICOFFV.EQ.IROFFC )
    If SIDE = 'Right',
      ( NB_V.EQ.NB_C .AND. ICOFFV.EQ.ICOFFC .AND. IVCOL.EQ.ICCOL )
  end if
  =====================================================================
     .. Parameters ..

Display dynamic version

FontSize: - +

001        SUBROUTINE PDLARZB( SIDE , TRANS , DIRECT , STOREV , M , N , K , L , V ,
002       $IV , JV , DESCV , T , C , IC , JC , DESCC , WORK )
003  
004  *     -- ScaLAPACK auxiliary routine(version 1.7) --
005  *     University of Tennessee , Knoxville , Oak Ridge National Laboratory ,
006  *     and University of California , Berkeley.
007  *     March 14 , 2000
008  
009  *     .. Scalar Arguments ..
010        CHARACTER DIRECT , SIDE , STOREV , TRANS
011        INTEGER IC , IV , JC , JV , K , L , M , N
012        INTEGER BLOCK_CYCLIC_2D , CSRC_ , CTXT_ , DLEN_ , DTYPE_ ,
013       $LLD_ , MB_ , M_ , NB_ , N_ , RSRC_
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        DOUBLE PRECISION ONE , ZERO
018        PARAMETER( ONE = 1.0D + 0 , ZERO = 0.0D + 0 )
019  *     ..
020  *     .. Local Scalars ..
021        LOGICAL LEFT
022        CHARACTER COLBTOP , TRANST
023        INTEGER ICCOL1 , ICCOL2 , ICOFFC1 , ICOFFC2 , ICOFFV ,
024       $ICROW1 , ICROW2 , ICTXT , IIBEG , IIC1 , IIC2 ,
025       $IIEND , IINXT , IIV , ILEFT , INFO , IOFFC2 , IOFFV ,
026       $IPT , IPV , IPW , IROFFC1 , IROFFC2 , ITOP , IVCOL ,
027       $IVROW , JJBEG , JJEND , JJNXT , JJC1 , JJC2 , JJV ,
028       $LDC , LDV , LV , LW , MBC , MBV , MPC1 , MPC2 , MPC20 ,
029       $MQV , MQV0 , MYCOL , MYDIST , MYROW , NBC , NBV ,
030       $NPCOL , NPROW , NQC1 , NQC2 , NQCALL , NQV
031  *     ..
032  *     .. External Subroutines ..
033        EXTERNAL BLACS_ABORT , BLACS_GRIDINFO , DGEBR2D ,
034       $DGEBS2D , DGEMM , DGSUM2D , DLACPY ,
035       $DLASET , DTRBR2D , DTRBS2D , DTRMM ,
036       $INFOG2L , PBDMATADD , PBDTRAN , PB_TOPGET , PXERBLA
037  *     ..
038  *     .. Intrinsic Functions ..
039        INTRINSIC MAX , MIN , MOD
040  *     ..
041  *     .. External Functions ..
042        LOGICAL LSAME
043        INTEGER ICEIL , NUMROC
044        EXTERNAL ICEIL , LSAME , NUMROC
045  *     ..
046  *     .. Executable Statements ..
047  
048  *     Quick return if possible
049  
050        IF( M.LE.0 .OR. N.LE.0 .OR. K.LE.0 )
050               
051       $    RETURN
052  
053  *         Get grid parameters
054  
055            ICTXT = DESCC( CTXT_ )
056            CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
057  
058  *         Check for currently supported options
059  
060            INFO = 0
061            IF( .NOT.LSAME( DIRECT , 'B' ) ) THEN
061                   
062                INFO = - 3
063            ELSE IF( .NOT.LSAME( STOREV , 'R' ) ) THEN
063                   
064                INFO = - 4
065            END IF
066            IF( INFO.NE.0 ) THEN
066                   
067                CALL PXERBLA( ICTXT , 'PDLARZB' , - INFO )
068                CALL BLACS_ABORT( ICTXT , 1 )
069                RETURN
070            END IF
071  
072            LEFT = LSAME( SIDE , 'L' )
073            IF( LSAME( TRANS , 'N' ) ) THEN
073                   
074                TRANST = 'T'
075            ELSE
075                   
076                TRANST = 'N'
077            END IF
078  
079            CALL INFOG2L( IV , JV , DESCV , NPROW , NPCOL , MYROW , MYCOL , IIV , JJV ,
080       $    IVROW , IVCOL )
081            MBV = DESCV( MB_ )
082            NBV = DESCV( NB_ )
083            ICOFFV = MOD( JV - 1 , NBV )
084            NQV = NUMROC( L + ICOFFV , NBV , MYCOL , IVCOL , NPCOL )
085            IF( MYCOL.EQ.IVCOL )
085                   
086       $        NQV = NQV - ICOFFV
087                LDV = DESCV( LLD_ )
088                IIV = MIN( IIV , LDV )
089                JJV = MIN( JJV , MAX( 1 , NUMROC( DESCV( N_ ) , NBV , MYCOL ,
090       $        DESCV( CSRC_ ) , NPCOL ) ) )
091                IOFFV = IIV + ( JJV - 1 ) * LDV
092                MBC = DESCC( MB_ )
093                NBC = DESCC( NB_ )
094                NQCALL = NUMROC( DESCC( N_ ) , NBC , MYCOL , DESCC( CSRC_ ) , NPCOL )
095                CALL INFOG2L( IC , JC , DESCC , NPROW , NPCOL , MYROW , MYCOL , IIC1 ,
096       $        JJC1 , ICROW1 , ICCOL1 )
097                LDC = DESCC( LLD_ )
098                IIC1 = MIN( IIC1 , LDC )
099                JJC1 = MIN( JJC1 , MAX( 1 , NQCALL ) )
100  
101                IF( LEFT ) THEN
101                       
102                    IROFFC1 = MOD( IC - 1 , MBC )
103                    MPC1 = NUMROC( K + IROFFC1 , MBC , MYROW , ICROW1 , NPROW )
104                    IF( MYROW.EQ.ICROW1 )
104                           
105       $                MPC1 = MPC1 - IROFFC1
106                        ICOFFC1 = MOD( JC - 1 , NBC )
107                        NQC1 = NUMROC( N + ICOFFC1 , NBC , MYCOL , ICCOL1 , NPCOL )
108                        IF( MYCOL.EQ.ICCOL1 )
108                               
109       $                    NQC1 = NQC1 - ICOFFC1
110                            CALL INFOG2L( IC + M - L , JC , DESCC , NPROW , NPCOL , MYROW , MYCOL ,
111       $                    IIC2 , JJC2 , ICROW2 , ICCOL2 )
112                            IROFFC2 = MOD( IC + M - L - 1 , MBC )
113                            MPC2 = NUMROC( L + IROFFC2 , MBC , MYROW , ICROW2 , NPROW )
114                            IF( MYROW.EQ.ICROW2 )
114                                   
115       $                        MPC2 = MPC2 - IROFFC2
116                                ICOFFC2 = ICOFFC1
117                                NQC2 = NQC1
118                            ELSE
118                                   
119                                IROFFC1 = MOD( IC - 1 , MBC )
120                                MPC1 = NUMROC( M + IROFFC1 , MBC , MYROW , ICROW1 , NPROW )
121                                IF( MYROW.EQ.ICROW1 )
121                                       
122       $                            MPC1 = MPC1 - IROFFC1
123                                    ICOFFC1 = MOD( JC - 1 , NBC )
124                                    NQC1 = NUMROC( K + ICOFFC1 , NBC , MYCOL , ICCOL1 , NPCOL )
125                                    IF( MYCOL.EQ.ICCOL1 )
125                                           
126       $                                NQC1 = NQC1 - ICOFFC1
127                                        CALL INFOG2L( IC , JC + N - L , DESCC , NPROW , NPCOL , MYROW , MYCOL ,
128       $                                IIC2 , JJC2 , ICROW2 , ICCOL2 )
129                                        IROFFC2 = IROFFC1
130                                        MPC2 = MPC1
131                                        ICOFFC2 = MOD( JC + N - L - 1 , NBC )
132                                        NQC2 = NUMROC( L + ICOFFC2 , NBC , MYCOL , ICCOL2 , NPCOL )
133                                        IF( MYCOL.EQ.ICCOL2 )
133                                               
134       $                                    NQC2 = NQC2 - ICOFFC2
135                                        END IF
136                                        IIC2 = MIN( IIC2 , LDC )
137                                        JJC2 = MIN( JJC2 , NQCALL )
138                                        IOFFC2 = IIC2 + ( JJC2 - 1 ) * LDC
139  
140                                        IF( LSAME( SIDE , 'L' ) ) THEN
141  
142  *                                         Form Q*sub( C ) or Q'*sub( C )
143  
144  *                                         IROFFC2 = ICOFFV is required by the current transposition
145  *                                         routine PBDTRAN
146  
146                                               
147                                            MQV0 = NUMROC( M + ICOFFV , NBV , MYCOL , IVCOL , NPCOL )
148                                            IF( MYCOL.EQ.IVCOL ) THEN
148                                                   
149                                                MQV = MQV0 - ICOFFV
150                                            ELSE
150                                                   
151                                                MQV = MQV0
152                                            END IF
153                                            IF( MYROW.EQ.ICROW2 ) THEN
153                                                   
154                                                MPC20 = MPC2 + IROFFC2
155                                            ELSE
155                                                   
156                                                MPC20 = MPC2
157                                            END IF
158  
159  *                                         Locally V( IOFFV ) is K x MQV , C( IOFFC2 ) is MPC2 x NQC2
160  *                                         WORK( IPV ) is MPC20 x K =[ . V( IOFFV ) ]'
161  *                                         WORK( IPW ) is K x MQV0 =[ . V( IOFFV ) ]
162  *                                         WORK( IPT ) is the workspace for PBDTRAN
163  
164                                            IPV = 1
165                                            IPW = IPV + MPC20 * K
166                                            IPT = IPW + K * MQV0
167                                            LV = MAX( 1 , MPC20 )
168                                            LW = MAX( 1 , K )
169  
170                                            IF( MYROW.EQ.IVROW ) THEN
170                                                   
171                                                IF( MYCOL.EQ.IVCOL ) THEN
171                                                       
172                                                    CALL DLACPY( 'All' , K , MQV , V( IOFFV ) , LDV ,
173       $                                            WORK( IPW + ICOFFV*LW ) , LW )
174                                                ELSE
174                                                       
175                                                    CALL DLACPY( 'All' , K , MQV , V( IOFFV ) , LDV ,
176       $                                            WORK( IPW ) , LW )
177                                                END IF
178                                            END IF
179  
180  *                                         WORK( IPV ) = WORK( IPW )'(replicated) is MPC20 x K
181  
182                                            CALL PBDTRAN( ICTXT , 'Rowwise' , 'Transpose' , K , M + ICOFFV ,
183       $                                    DESCV( NB_ ) , WORK( IPW ) , LW , ZERO ,
184       $                                    WORK( IPV ) , LV , IVROW , IVCOL , ICROW2 , - 1 ,
185       $                                    WORK( IPT ) )
186  
187  *                                         WORK( IPV ) =( . V )' -> WORK( IPV ) = V' is MPC2 x K
188  
189                                            IF( MYROW.EQ.ICROW2 )
189                                                   
190       $                                        IPV = IPV + IROFFC2
191  
192  *                                             WORK( IPW ) becomes NQC2 x K = C( IOFFC2 )' * V'
193  *                                             WORK( IPW ) = C( IOFFC2 )' * V'(NQC2 x MPC2 x K) -> NQC2 x K
194  
195                                                LW = MAX( 1 , NQC2 )
196  
197                                                IF( MPC2.GT.0 ) THEN
197                                                       
198                                                    CALL DGEMM( 'Transpose' , 'No transpose' , NQC2 , K , MPC2 ,
199       $                                            ONE , C( IOFFC2 ) , LDC , WORK( IPV ) , LV , ZERO ,
200       $                                            WORK( IPW ) , LW )
201                                                ELSE
201                                                       
202                                                    CALL DLASET( 'All' , NQC2 , K , ZERO , ZERO , WORK( IPW ) , LW )
203                                                END IF
204  
205  *                                             WORK( IPW ) = WORK( IPW ) + C1( NQC1 = NQC2 )
206  
207                                                IF( MPC1.GT.0 ) THEN
207                                                       
208                                                    MYDIST = MOD( MYROW - ICROW1 + NPROW , NPROW )
209                                                    ITOP = MAX( 0 , MYDIST * MBC - IROFFC1 )
210                                                    IIBEG = IIC1
211                                                    IIEND = IIC1 + MPC1 - 1
212                                                    IINXT = MIN( ICEIL( IIBEG , MBC ) * MBC , IIEND )
213  
214     10 CONTINUE
215        IF( IIBEG.LE.IINXT ) THEN
215               
216            CALL PBDMATADD( ICTXT , 'Transpose' , NQC2 , IINXT - IIBEG + 1 ,
217       $    ONE , C( IIBEG + (JJC1 - 1)*LDC ) , LDC , ONE ,
218       $    WORK( IPW + ITOP ) , LW )
219            MYDIST = MYDIST + NPROW
220            ITOP = MYDIST * MBC - IROFFC1
221            IIBEG = IINXT + 1
222            IINXT = MIN( IINXT + MBC , IIEND )
223            GO TO 10
224        END IF
225        END IF
226  
227        CALL DGSUM2D( ICTXT , 'Columnwise' , ' ' , NQC2 , K , WORK( IPW ) ,
228       $LW , IVROW , MYCOL )
229  
230  *     WORK( IPW ) = WORK( IPW ) * T' or WORK( IPW ) * T
231  
232        IF( MYROW.EQ.IVROW ) THEN
232               
233            IF( MYCOL.EQ.IVCOL ) THEN
234  
235  *             Broadcast the block reflector to the other columns.
236  
236                   
237                CALL DTRBS2D( ICTXT , 'Rowwise' , ' ' , 'Lower' , 'Non unit' ,
238       $        K , K , T , MBV )
239            ELSE
239                   
240                CALL DTRBR2D( ICTXT , 'Rowwise' , ' ' , 'Lower' , 'Non unit' ,
241       $        K , K , T , MBV , MYROW , IVCOL )
242            END IF
243            CALL DTRMM( 'Right' , 'Lower' , TRANST , 'Non unit' , NQC2 , K ,
244       $    ONE , T , MBV , WORK( IPW ) , LW )
245  
246            CALL DGEBS2D( ICTXT , 'Columnwise' , ' ' , NQC2 , K ,
247       $    WORK( IPW ) , LW )
248        ELSE
248               
249            CALL DGEBR2D( ICTXT , 'Columnwise' , ' ' , NQC2 , K ,
250       $    WORK( IPW ) , LW , IVROW , MYCOL )
251        END IF
252  
253  *     C1 = C1 - WORK( IPW )
254  
255        IF( MPC1.GT.0 ) THEN
255               
256            MYDIST = MOD( MYROW - ICROW1 + NPROW , NPROW )
257            ITOP = MAX( 0 , MYDIST * MBC - IROFFC1 )
258            IIBEG = IIC1
259            IIEND = IIC1 + MPC1 - 1
260            IINXT = MIN( ICEIL( IIBEG , MBC ) * MBC , IIEND )
261  
262     20 CONTINUE
263        IF( IIBEG.LE.IINXT ) THEN
263               
264            CALL PBDMATADD( ICTXT , 'Transpose' , IINXT - IIBEG + 1 , NQC2 ,
265       $    - ONE , WORK( IPW + ITOP ) , LW , ONE ,
266       $    C( IIBEG + (JJC1 - 1)*LDC ) , LDC )
267            MYDIST = MYDIST + NPROW
268            ITOP = MYDIST * MBC - IROFFC1
269            IIBEG = IINXT + 1
270            IINXT = MIN( IINXT + MBC , IIEND )
271            GO TO 20
272        END IF
273        END IF
274  
275  *     C2 C2 - V' * W'
276  *     C( IOFFC2 ) = C( IOFFC2 ) - WORK( IPV ) * WORK( IPW )'
277  *     MPC2 x NQC2 MPC2 x K K x NQC2
278  
279        CALL DGEMM( 'No transpose' , 'Transpose' , MPC2 , NQC2 , K , - ONE ,
280       $WORK( IPV ) , LV , WORK( IPW ) , LW , ONE ,
281       $C( IOFFC2 ) , LDC )
282  
283        ELSE
284  
285  *         Form sub( C ) * Q or sub( C ) * Q'
286  
287  *         Locally V( IOFFV ) is K x NQV , C( IOFFC2 ) is MPC2 x NQC2
288  *         WORK( IPV ) is K x NQV = V( IOFFV ) , NQV = NQC2
289  *         WORK( IPW ) is MPC2 x K = C( IOFFC2 ) * V( IOFFV )'
290  
290               
291            IPV = 1
292            IPW = IPV + K * NQC2
293            LV = MAX( 1 , K )
294            LW = MAX( 1 , MPC2 )
295  
296  *         Broadcast V to the other process rows.
297  
298            CALL PB_TOPGET( ICTXT , 'Broadcast' , 'Columnwise' , COLBTOP )
299            IF( MYROW.EQ.IVROW ) THEN
299                   
300                CALL DGEBS2D( ICTXT , 'Columnwise' , COLBTOP , K , NQC2 ,
301       $        V( IOFFV ) , LDV )
302                IF( MYCOL.EQ.IVCOL )
302                       
303       $            CALL DTRBS2D( ICTXT , 'Columnwise' , COLBTOP , 'Lower' ,
304       $            'Non unit' , K , K , T , MBV )
305                    CALL DLACPY( 'All' , K , NQC2 , V( IOFFV ) , LDV , WORK( IPV ) ,
306       $            LV )
307                ELSE
307                       
308                    CALL DGEBR2D( ICTXT , 'Columnwise' , COLBTOP , K , NQC2 ,
309       $            WORK( IPV ) , LV , IVROW , MYCOL )
310                    IF( MYCOL.EQ.IVCOL )
310                           
311       $                CALL DTRBR2D( ICTXT , 'Columnwise' , COLBTOP , 'Lower' ,
312       $                'Non unit' , K , K , T , MBV , IVROW , MYCOL )
313                    END IF
314  
315  *                 WORK( IPV ) is K x NQC2 = V = V( IOFFV )
316  *                 WORK( IPW ) = C( IOFFC2 ) * V'(MPC2 x NQC2 x K) -> MPC2 x K
317  
318                    IF( NQC2.GT.0 ) THEN
318                           
319                        CALL DGEMM( 'No Transpose' , 'Transpose' , MPC2 , K , NQC2 ,
320       $                ONE , C( IOFFC2 ) , LDC , WORK( IPV ) , LV , ZERO ,
321       $                WORK( IPW ) , LW )
322                    ELSE
322                           
323                        CALL DLASET( 'All' , MPC2 , K , ZERO , ZERO , WORK( IPW ) , LW )
324                    END IF
325  
326  *                 WORK( IPW ) = WORK( IPW ) + C1( MPC1 = MPC2 )
327  
328                    IF( NQC1.GT.0 ) THEN
328                           
329                        MYDIST = MOD( MYCOL - ICCOL1 + NPCOL , NPCOL )
330                        ILEFT = MAX( 0 , MYDIST * NBC - ICOFFC1 )
331                        JJBEG = JJC1
332                        JJEND = JJC1 + NQC1 - 1
333                        JJNXT = MIN( ICEIL( JJBEG , NBC ) * NBC , JJEND )
334  
335     30 CONTINUE
336        IF( JJBEG.LE.JJNXT ) THEN
336               
337            CALL PBDMATADD( ICTXT , 'No transpose' , MPC2 ,
338       $    JJNXT - JJBEG + 1 , ONE ,
339       $    C( IIC1 + (JJBEG - 1)*LDC ) , LDC , ONE ,
340       $    WORK( IPW + ILEFT*LW ) , LW )
341            MYDIST = MYDIST + NPCOL
342            ILEFT = MYDIST * NBC - ICOFFC1
343            JJBEG = JJNXT + 1
344            JJNXT = MIN( JJNXT + NBC , JJEND )
345            GO TO 30
346        END IF
347        END IF
348  
349        CALL DGSUM2D( ICTXT , 'Rowwise' , ' ' , MPC2 , K , WORK( IPW ) ,
350       $LW , MYROW , IVCOL )
351  
352  *     WORK( IPW ) = WORK( IPW ) * T' or WORK( IPW ) * T
353  
354        IF( MYCOL.EQ.IVCOL ) THEN
354               
355            CALL DTRMM( 'Right' , 'Lower' , TRANS , 'Non unit' , MPC2 , K ,
356       $    ONE , T , MBV , WORK( IPW ) , LW )
357            CALL DGEBS2D( ICTXT , 'Rowwise' , ' ' , MPC2 , K , WORK( IPW ) ,
358       $    LW )
359        ELSE
359               
360            CALL DGEBR2D( ICTXT , 'Rowwise' , ' ' , MPC2 , K , WORK( IPW ) ,
361       $    LW , MYROW , IVCOL )
362        END IF
363  
364  *     C1 = C1 - WORK( IPW )
365  
366        IF( NQC1.GT.0 ) THEN
366               
367            MYDIST = MOD( MYCOL - ICCOL1 + NPCOL , NPCOL )
368            ILEFT = MAX( 0 , MYDIST * NBC - ICOFFC1 )
369            JJBEG = JJC1
370            JJEND = JJC1 + NQC1 - 1
371            JJNXT = MIN( ICEIL( JJBEG , NBC ) * NBC , JJEND )
372  
373     40 CONTINUE
374        IF( JJBEG.LE.JJNXT ) THEN
374               
375            CALL PBDMATADD( ICTXT , 'No transpose' , MPC2 ,
376       $    JJNXT - JJBEG + 1 , - ONE ,
377       $    WORK( IPW + ILEFT*LW ) , LW , ONE ,
378       $    C( IIC1 + (JJBEG - 1)*LDC ) , LDC )
379            MYDIST = MYDIST + NPCOL
380            ILEFT = MYDIST * NBC - ICOFFC1
381            JJBEG = JJNXT + 1
382            JJNXT = MIN( JJNXT + NBC , JJEND )
383            GO TO 40
384        END IF
385        END IF
386  
387  *     C2 C2 - W * V
388  *     C( IOFFC ) = C( IOFFC ) - WORK( IPW ) * WORK( IPV )
389  *     MPC2 x NQC2 MPC2 x K K x NQC2
390  
391        IF( IOFFC2.GT.0 )
391               
392       $    CALL DGEMM( 'No transpose' , 'No transpose' , MPC2 , NQC2 , K ,
393       $    - ONE , WORK( IPW ) , LW , WORK( IPV ) , LV , ONE ,
394       $    C( IOFFC2 ) , LDC )
395  
396        END IF
397  
398        RETURN
399  
400  *     End of PDLARZB
401  
402        END5062

Variables in Routine PDLARZB()

Summary Report
Data Type	Quantity	Size(byte)
CHARACTER	6	6
DOUBLE PRECISION	2	8
INTEGER	75	300
LOGICAL	2	2
TOTAL	85	316

List of Variables

CHARACTER

COLBTOP DIRECT SIDE STOREV TRANS
TRANST

DOUBLE PRECISION

ONE ZERO

INTEGER

BLOCK_CYCLIC_2D CSRC_ CTXT_ DLEN_ DTYPE_
IC ICCOL1 ICCOL2 ICEIL ICOFFC1
ICOFFC2 ICOFFV ICROW1 ICROW2 ICTXT
IIBEG IIC1 IIC2 IIEND IINXT
IIV ILEFT INFO IOFFC2 IOFFV
IPT IPV IPW IROFFC1 IROFFC2
ITOP IV IVCOL IVROW JC
JJBEG JJC1 JJC2 JJEND JJNXT
JJV JV K L LDC
LDV LLD_ LV LW M
M_ MB_ MBC MBV MPC1
MPC2 MPC20 MQV MQV0 MYCOL
MYDIST MYROW N N_ NB_
NBC NBV NPCOL NPROW NQC1
NQC2 NQCALL NQV NUMROC RSRC_

LOGICAL

LEFT LSAME

Variables Dependence Graph
Put the mouse over a right hand side variable to display the corresponding line of the dependence
-
- -
ICOFFC1 <--- JCICOFFC1 = MOD( JC-1, NBC ){2ICOFFC1 = MOD( JC-1, NBC )}, NBCICOFFC1 = MOD( JC-1, NBC ){2ICOFFC1 = MOD( JC-1, NBC )}

ICOFFC2 <--- ICOFFC1ICOFFC2 = ICOFFC1, JCICOFFC2 = MOD( JC+N-L-1, NBC ), LICOFFC2 = MOD( JC+N-L-1, NBC ), NICOFFC2 = MOD( JC+N-L-1, NBC ), NBCICOFFC2 = MOD( JC+N-L-1, NBC )

ICOFFV <--- JVICOFFV = MOD( JV-1, NBV ), NBVICOFFV = MOD( JV-1, NBV )

ICTXT <--- CTXT_ICTXT = DESCC( CTXT_ )

IIBEG <--- IIC1IIBEG = IIC1{2IIBEG = IIC1}, IINXTIIBEG = IINXT +1{2IIBEG = IINXT +1}

IIC1 <--- IIC1IIC1 = MIN( IIC1, LDC ), LDCIIC1 = MIN( IIC1, LDC )

IIC2 <--- IIC2IIC2 = MIN( IIC2, LDC ), LDCIIC2 = MIN( IIC2, LDC )

IIEND <--- IIC1IIEND = IIC1 + MPC1 - 1{2IIEND = IIC1 + MPC1 - 1}, MPC1IIEND = IIC1 + MPC1 - 1{2IIEND = IIC1 + MPC1 - 1}

IINXT <--- ICEIL{2}, IIBEG{2}, IIEND{2IINXT = MIN( IINXT+MBC, IIEND ), 3, 4IINXT = MIN( IINXT+MBC, IIEND )}, IINXTIINXT = MIN( IINXT+MBC, IIEND ){2IINXT = MIN( IINXT+MBC, IIEND )}, MBC{2IINXT = MIN( IINXT+MBC, IIEND ), 3, 4IINXT = MIN( IINXT+MBC, IIEND )}

IIV <--- IIVIIV = MIN( IIV, LDV ), LDVIIV = MIN( IIV, LDV )

ILEFT <--- ICOFFC1{2ILEFT = MYDIST * NBC - ICOFFC1, 3, 4ILEFT = MYDIST * NBC - ICOFFC1}, MYDIST{2ILEFT = MYDIST * NBC - ICOFFC1, 3, 4ILEFT = MYDIST * NBC - ICOFFC1}, NBC{2ILEFT = MYDIST * NBC - ICOFFC1, 3, 4ILEFT = MYDIST * NBC - ICOFFC1}

IOFFC2 <--- IIC2IOFFC2 = IIC2 + ( JJC2-1 ) * LDC, JJC2IOFFC2 = IIC2 + ( JJC2-1 ) * LDC, LDCIOFFC2 = IIC2 + ( JJC2-1 ) * LDC

IOFFV <--- IIVIOFFV = IIV + ( JJV-1 ) * LDV, JJVIOFFV = IIV + ( JJV-1 ) * LDV, LDVIOFFV = IIV + ( JJV-1 ) * LDV

IPT <--- IPWIPT = IPW + K * MQV0, KIPT = IPW + K * MQV0, MQV0IPT = IPW + K * MQV0

IPW <--- IPVIPW = IPV + MPC20 * K{2IPW = IPV + K * NQC2}, KIPW = IPV + MPC20 * K{2IPW = IPV + K * NQC2}, MPC20IPW = IPV + MPC20 * K, NQC2IPW = IPV + K * NQC2

IROFFC1 <--- MBCIROFFC1 = MOD( IC-1, MBC ){2IROFFC1 = MOD( IC-1, MBC )}, ICIROFFC1 = MOD( IC-1, MBC ){2IROFFC1 = MOD( IC-1, MBC )}

IROFFC2 <--- IROFFC1IROFFC2 = IROFFC1, LIROFFC2 = MOD( IC+M-L-1, MBC ), MIROFFC2 = MOD( IC+M-L-1, MBC ), MBCIROFFC2 = MOD( IC+M-L-1, MBC ), ICIROFFC2 = MOD( IC+M-L-1, MBC )

ITOP <--- IROFFC1ITOP = MAX( 0, MYDIST * MBC - IROFFC1 ){2ITOP = MYDIST * MBC - IROFFC1, 3ITOP = MAX( 0, MYDIST * MBC - IROFFC1 ), 4ITOP = MYDIST * MBC - IROFFC1}, MBCITOP = MAX( 0, MYDIST * MBC - IROFFC1 ){2ITOP = MYDIST * MBC - IROFFC1, 3ITOP = MAX( 0, MYDIST * MBC - IROFFC1 ), 4ITOP = MYDIST * MBC - IROFFC1}, MYDISTITOP = MAX( 0, MYDIST * MBC - IROFFC1 ){2ITOP = MYDIST * MBC - IROFFC1, 3ITOP = MAX( 0, MYDIST * MBC - IROFFC1 ), 4ITOP = MYDIST * MBC - IROFFC1}

JJBEG <--- JJC1JJBEG = JJC1{2JJBEG = JJC1}, JJNXTJJBEG = JJNXT +1{2JJBEG = JJNXT +1}

JJC1 <--- JJC1JJC1 = MIN( JJC1, MAX( 1, NQCALL ) ), NQCALLJJC1 = MIN( JJC1, MAX( 1, NQCALL ) )

JJC2 <--- JJC2JJC2 = MIN( JJC2, NQCALL ), NQCALLJJC2 = MIN( JJC2, NQCALL )

JJEND <--- JJC1JJEND = JJC1 + NQC1 - 1{2JJEND = JJC1 + NQC1 - 1}, NQC1JJEND = JJC1 + NQC1 - 1{2JJEND = JJC1 + NQC1 - 1}

JJNXT <--- ICEIL{2}, JJBEG{2}, JJEND{2JJNXT = MIN( JJNXT+NBC, JJEND ), 3, 4JJNXT = MIN( JJNXT+NBC, JJEND )}, JJNXTJJNXT = MIN( JJNXT+NBC, JJEND ){2JJNXT = MIN( JJNXT+NBC, JJEND )}, NBC{2JJNXT = MIN( JJNXT+NBC, JJEND ), 3, 4JJNXT = MIN( JJNXT+NBC, JJEND )}

JJV <--- CSRC_, JJV, MYCOL, N_, NBV, NPCOL, NUMROC

LDC <--- LLD_LDC = DESCC( LLD_ )

LDV <--- LLD_LDV = DESCV( LLD_ )

LEFT <--- LLEFT = LSAME( SIDE, 'L' ), LSAMELEFT = LSAME( SIDE, 'L' ), SIDELEFT = LSAME( SIDE, 'L' )

LV <--- KLV = MAX( 1, K ), MPC20LV = MAX( 1, MPC20 )

LW <--- KLW = MAX( 1, K ), MPC2LW = MAX( 1, MPC2 ), NQC2LW = MAX( 1, NQC2 )

MBC <--- MB_MBC = DESCC( MB_ )

MBV <--- MB_MBV = DESCV( MB_ )

MPC1 <--- ICROW1{2}, IROFFC1{2}, K, M, MBC{2}, MYROW{2}, NPROW{2}, NUMROC{2}

MPC2 <--- ICROW2, IROFFC2, L, MBC, MPC1MPC2 = MPC1, MYROW, NPROW, NUMROC

MPC20 <--- IROFFC2MPC20 = MPC2 + IROFFC2, MPC2MPC20 = MPC2 + IROFFC2{2MPC20 = MPC2}

MQV <--- ICOFFVMQV = MQV0 - ICOFFV, MQV0MQV = MQV0 - ICOFFV{2MQV = MQV0}

MQV0 <--- ICOFFV, IVCOL, M, MYCOL, NBV, NPCOL, NUMROC

MYDIST <--- ICROW1{2}, MYCOL{2}, MYDISTMYDIST = MYDIST + NPROW{2MYDIST = MYDIST + NPROW, 3MYDIST = MYDIST + NPCOL, 4MYDIST = MYDIST + NPCOL}, MYROW{2}, NPCOL{2MYDIST = MYDIST + NPCOL, 3, 4MYDIST = MYDIST + NPCOL}, NPROW{2MYDIST = MYDIST + NPROW, 3, 4MYDIST = MYDIST + NPROW}, ICCOL1{2}

NBC <--- NB_NBC = DESCC( NB_ )

NBV <--- NB_NBV = DESCV( NB_ )

NQC1 <--- ICOFFC1{2}, K, MYCOL{2}, N, NBC{2}, NPCOL{2}, NUMROC{2}, ICCOL1{2}

NQC2 <--- ICCOL2, ICOFFC2, L, MYCOL, NBC, NPCOL, NQC1NQC2 = NQC1, NUMROC

NQCALL <--- CSRC_, MYCOL, N_, NBC, NPCOL, NUMROC

NQV <--- ICOFFV, IVCOL, L, MYCOL, NBV, NPCOL, NUMROC

TRANST <--- NTRANST = 'N'

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

Assigned variables
		BLOCK_CYCLIC_2D , CSRC_ , CTXT_ , DLEN_ , DTYPE_ , ICOFFC1 , ICOFFC2 , ICOFFV , ICTXT , IIBEG , IIC1 , IIC2 , IIEND , IINXT , IIV , ILEFT , INFO , IOFFC2 , IOFFV , IPT , IPV , IPW , IROFFC1 , IROFFC2 , ITOP , JJBEG , JJC1 , JJC2 , JJEND , JJNXT , JJV , K , LDC , LDV , LEFT , LLD_ , LV , LW , M_ , MB_ , MBC , MBV , MPC1 , MPC2 , MPC20 , MQV , MQV0 , MYDIST , N_ , NB_ , NBC , NBV , NQC1 , NQC2 , NQCALL , NQV , ONE , RSRC_ , TRANST , V , ZERO

Active variables
		BLOCK_CYCLIC_2D , C , COLBTOP , CSRC_ , CTXT_ , DESCC , DESCV , DIRECT , DLEN_ , DTYPE_ , IC , ICCOL1 , ICCOL2 , ICEIL , ICOFFC1 , ICOFFC2 , ICOFFV , ICROW1 , ICROW2 , ICTXT , IIBEG , IIC1 , IIC2 , IIEND , IINXT , IIV , ILEFT , INFO , IOFFC2 , IOFFV , IPT , IPV , IPW , IROFFC1 , IROFFC2 , ITOP , IV , IVCOL , IVROW , JC , JJBEG , JJC1 , JJC2 , JJEND , JJNXT , JJV , JV , K , L , LDC , LDV , LEFT , LLD_ , LSAME , LV , LW , M , M_ , MB_ , MBC , MBV , MPC1 , MPC2 , MPC20 , MQV , MQV0 , MYCOL , MYDIST , MYROW , N , N_ , NB_ , NBC , NBV , NPCOL , NPROW , NQC1 , NQC2 , NQCALL , NQV , NUMROC , ONE , RSRC_ , SIDE , STOREV , T , TRANS , TRANST , V , WORK , ZERO

Accessed arrays [ array name : associated index ]
	C	: IIBEG+(JJC1-1)LDC , IIBEG+(JJC1-1)LDC , IIC1+(JJBEG-1)LDC , IIC1+(JJBEG-1)LDC , IOFFC , IOFFC2 , IOFFC2 , IOFFC2 , IOFFC2 , IOFFC2 , IOFFC2 , IOFFC2 , IOFFC2 , IOFFC2 , IOFFC2 , IOFFC2
	DESCC	: CSRC_ , CTXT_ , LLD_ , MB_ , N_ , NB_
	DESCV	: CSRC_ , LLD_ , MB_ , N_ , NB_ , NB_
	ICEIL	: IIBEG, MBC , IIBEG, MBC , JJBEG, NBC , JJBEG, NBC
	LSAME	: DIRECT, 'B' , SIDE, 'L' , SIDE, 'L' , STOREV, 'R' , TRANS, 'N'
	NUMROC	: DESCC( N_ ), NBC, MYCOL, DESCC( CSRC_ ), NPCOL , K+ICOFFC1, NBC, MYCOL, ICCOL1, NPCOL , K+IROFFC1, MBC, MYROW, ICROW1, NPROW , L+ICOFFC2, NBC, MYCOL, ICCOL2, NPCOL , L+ICOFFV, NBV, MYCOL, IVCOL, NPCOL , L+IROFFC2, MBC, MYROW, ICROW2, NPROW , M+ICOFFV, NBV, MYCOL, IVCOL, NPCOL , M+IROFFC1, MBC, MYROW, ICROW1, NPROW , N+ICOFFC1, NBC, MYCOL, ICCOL1, NPCOL
	V	: IOFFV , IOFFV , IOFFV , IOFFV , IOFFV , IOFFV , IOFFV , IOFFV , IOFFV , IOFFV , IOFFV
	WORK	: IPT , IPT , IPV , IPV , IPV , IPV , IPV , IPV , IPV , IPV , IPV , IPV , IPV , IPV , IPV , IPV , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW , IPW+ICOFFVLW , IPW+ILEFTLW , IPW+ILEFT*LW , IPW+ITOP , IPW+ITOP

Conditional statements [ statement : associated predicate ]
	for	: `(` currently supported options `)` , `(` PBDTRAN `)`
	if	: `(` possible `)` , `(` M.LE.0 .OR. N.LE.0 .OR. K.LE.0 `)` , `(` (.NOT.LSAME( DIRECT , 'B' ) ) `)` , `(` (.NOT.LSAME( STOREV , 'R' ) ) `)` , `(` INFO.NE.0 `)` , `(` (LSAME( TRANS , 'N' ) ) `)` , `(` MYCOL.EQ.IVCOL `)` , `(` LEFT `)` , `(` MYROW.EQ.ICROW1 `)` , `(` MYCOL.EQ.ICCOL1 `)` , `(` MYROW.EQ.ICROW2 `)` , `(` MYROW.EQ.ICROW1 `)` , `(` MYCOL.EQ.ICCOL1 `)` , `(` MYCOL.EQ.ICCOL2 `)` , `(` (LSAME( SIDE , 'L' ) ) `)` , `(` MYCOL.EQ.IVCOL `)` , `(` MYROW.EQ.ICROW2 `)` , `(` MYROW.EQ.IVROW `)` , `(` MYCOL.EQ.IVCOL `)` , `(` MYROW.EQ.ICROW2 `)` , `(` MPC2.GT.0 `)` , `(` MPC1.GT.0 `)` , `(` IIBEG.LE.IINXT `)` , `(` MYROW.EQ.IVROW `)` , `(` MYCOL.EQ.IVCOL `)` , `(` MPC1.GT.0 `)` , `(` IIBEG.LE.IINXT `)` , `(` MYROW.EQ.IVROW `)` , `(` MYCOL.EQ.IVCOL `)` , `(` MYCOL.EQ.IVCOL `)` , `(` NQC2.GT.0 `)` , `(` NQC1.GT.0 `)` , `(` JJBEG.LE.JJNXT `)` , `(` MYCOL.EQ.IVCOL `)` , `(` NQC1.GT.0 `)` , `(` JJBEG.LE.JJNXT `)` , `(` IOFFC2.GT.0 `)`