pbztran.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	pbztran (icontxt, adist, trans, m, n, nb, a, lda, beta, c, ldc, iarow, iacol, icrow, iccol, work)
subroutine	pbztr2at (icontxt, adist, trans, m, n, nb, a, lda, beta, b, ldb, lcmp, lcmq)
subroutine	pbztr2bt (icontxt, adist, trans, m, n, nb, a, lda, beta, b, ldb, intv)
subroutine	pbztr2af (icontxt, adist, m, n, nb, a, lda, beta, b, ldb, lcmp, lcmq, nint)

Function/Subroutine Documentation

pbztr2af()

subroutine pbztr2af	(	integer	icontxt,
		character*1	adist,
		integer	m,
		integer	n,
		integer	nb,
		complex*16, dimension( lda, * )	a,
		integer	lda,
		complex*16	beta,
		complex*16, dimension( ldb, * )	b,
		integer	ldb,
		integer	lcmp,
		integer	lcmq,
		integer	nint )

Definition at line 791 of file pbztran.f.

*
*  -- PB-BLAS routine (version 2.1) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory.
*     April 28, 1996
*
*     .. Scalar Arguments ..
      CHARACTER*1          ADIST
      INTEGER              ICONTXT, M, N, NB, LDA, LDB, LCMP, LCMQ, NINT
      COMPLEX*16           BETA
*     ..
*     .. Array Arguments ..
      COMPLEX*16           A( LDA, * ), B( LDB, * )
*     ..
*
*  Purpose
*  =======
*
*  PBZTR2AF forms  T <== A + BETA*T, where T is a scattered block
*  row (or column) copied from a (condensed) block column (or row) of A
*
*  =====================================================================
*
*     .. Parameters ..
      COMPLEX*16         ONE
      parameter( one = ( 1.0d+0, 0.0d+0 ) )
*     ..
*     .. Local Scalars ..
      INTEGER            JA, JB, K, INTV
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      INTEGER            ICEIL
      EXTERNAL           lsame, iceil
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          min
*     ..
*     .. Executable Statements ..
*
      IF( lsame( adist, 'R' ) ) THEN
         intv = nb * lcmq
         ja = 1
         jb = 1
         DO 10 k = 1, iceil( nint, nb )
            CALL pbzmatadd( icontxt, 'G', m, min( n-jb+1, nb ), one,
     $                      a(1,ja), lda, beta, b(1,jb), ldb )
            ja = ja + nb
            jb = jb + intv
   10    CONTINUE
*
*     if( LSAME( ADIST, 'C' ) ) then
*
      ELSE
         intv = nb * lcmp
         ja = 1
         jb = 1
         DO 20 k = 1, iceil( nint, nb )
            CALL pbzmatadd( icontxt, 'G', min( m-jb+1, nb ), n, one,
     $                      a(ja,1), lda, beta, b(jb,1), ldb )
            ja = ja + nb
            jb = jb + intv
   20    CONTINUE
      END IF
*
      RETURN
*
*     End of PBZTR2AF
*

pbztr2at()

subroutine pbztr2at	(	integer	icontxt,
		character*1	adist,
		character*1	trans,
		integer	m,
		integer	n,
		integer	nb,
		complex*16, dimension( lda, * )	a,
		integer	lda,
		complex*16	beta,
		complex*16, dimension( ldb, * )	b,
		integer	ldb,
		integer	lcmp,
		integer	lcmq )

Definition at line 613 of file pbztran.f.

*
*  -- PB-BLAS routine (version 2.1) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory.
*     April 28, 1996
*
*     .. Scalar Arguments ..
      CHARACTER*1        ADIST, TRANS
      INTEGER            ICONTXT, LCMP, LCMQ, LDA, LDB, M, N, NB
      COMPLEX*16         BETA
*     ..
*     .. Array Arguments ..
      COMPLEX*16         A( LDA, * ), B( LDB, * )
*     ..
*
*  Purpose
*  =======
*
*  PBZTR2AT forms   B <== A^T + beta*B, or A^C + beta*B
*  B is a ((conjugate) transposed) scattered block row (or column),
*  copied from a scattered block column (or row) of A
*
*  =====================================================================
*
*     .. Parameters ..
      COMPLEX*16         ONE
      parameter( one  = ( 1.0d+0, 0.0d+0 ) )
*     ..
*     .. Local Scalars ..
      INTEGER            IA, IB, K, INTV, JNTV
*     ..
*     .. External Subroutines ..
      EXTERNAL           pbzmatadd
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      INTEGER            ICEIL
      EXTERNAL           lsame, iceil
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          min
*     ..
*     .. Excutable Statements ..
*
      IF( lcmp.EQ.lcmq ) THEN
         CALL pbzmatadd( icontxt, trans, n, m, one, a, lda, beta, b,
     $                   ldb )
*
      ELSE
*
*        If A is a column block ( ADIST = 'C' ),
*
         IF( lsame( adist, 'C' ) ) THEN
            intv = lcmp * nb
            jntv = lcmq * nb
            ia = 1
            ib = 1
            DO 10 k = 1, iceil( m, intv )
               CALL pbzmatadd( icontxt, trans, n, min( m-ia+1, nb ),
     $                         one, a(ia,1), lda, beta, b(1,ib), ldb )
               ia = ia + intv
               ib = ib + jntv
   10       CONTINUE
*
*        If A is a row block ( ADIST = 'R' ),
*
         ELSE
            intv = lcmp * nb
            jntv = lcmq * nb
            ia = 1
            ib = 1
            DO 20 k = 1, iceil( n, jntv )
               CALL pbzmatadd( icontxt, trans, min( n-ia+1, nb ), m,
     $                         one, a(1,ia), lda, beta, b(ib,1), ldb )
               ia = ia + jntv
               ib = ib + intv
   20       CONTINUE
         END IF
      END IF
*
      RETURN
*
*     End of PBZTR2AT
*

pbztr2bt()

subroutine pbztr2bt	(	integer	icontxt,
		character*1	adist,
		character*1	trans,
		integer	m,
		integer	n,
		integer	nb,
		complex*16, dimension( lda, * )	a,
		integer	lda,
		complex*16	beta,
		complex*16, dimension( ldb, * )	b,
		integer	ldb,
		integer	intv )

Definition at line 704 of file pbztran.f.

*
*  -- PB-BLAS routine (version 2.1) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory.
*     April 28, 1996
*
*     .. Scalar Arguments ..
      CHARACTER*1        ADIST, TRANS
      INTEGER            ICONTXT, INTV, LDA, LDB, M, N, NB
      COMPLEX*16         BETA
*     ..
*     .. Array Arguments ..
      COMPLEX*16         A( LDA, * ), B( LDB, * )
*     ..
*
*  Purpose
*  =======
*
*  PBZTR2BT forms T <== A^T + beta*T or A^C + beta*T, where T is a
*  ((conjugate) transposed) condensed block row (or column), copied from
*  a scattered block column (or row) of A
*
*  =====================================================================
*
*     .. Parameters ..
      COMPLEX*16         ONE
      parameter( one  = ( 1.0d+0, 0.0d+0 ) )
*     ..
*     .. Local Scalars ..
      INTEGER            IA, IB, K
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      INTEGER            ICEIL
      EXTERNAL           lsame, iceil
*     ..
*     .. External Subroutines ..
      EXTERNAL           pbzmatadd
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          min
*     ..
*     .. Excutable Statements ..
*
      IF( intv.EQ.nb ) THEN
         CALL pbzmatadd( icontxt, trans, n, m, one, a, lda, beta, b,
     $                   ldb )
*
      ELSE
*
*        If A is a column block ( ADIST = 'C' ),
*
         IF( lsame( adist, 'C' ) ) THEN
            ia = 1
            ib = 1
            DO 10 k = 1, iceil( m, intv )
               CALL pbzmatadd( icontxt, trans, n, min( m-ia+1, nb ),
     $                         one, a(ia,1), lda, beta, b(1,ib), ldb )
               ia = ia + intv
               ib = ib + nb
   10       CONTINUE
*
*        If A is a row block (ADIST = 'R'),
*
         ELSE
            ia = 1
            ib = 1
            DO 20 k = 1, iceil( n, intv )
               CALL pbzmatadd( icontxt, trans, min( n-ia+1, nb ), m,
     $                         one, a(1,ia), lda, beta, b(ib,1), ldb )
               ia = ia + intv
               ib = ib + nb
   20       CONTINUE
         END IF
      END IF
*
      RETURN
*
*     End of PBZTR2BT
*

pbztran()

subroutine pbztran	(	integer	icontxt,
		character*1	adist,
		character*1	trans,
		integer	m,
		integer	n,
		integer	nb,
		complex*16, dimension( lda, * )	a,
		integer	lda,
		complex*16	beta,
		complex*16, dimension( ldc, * )	c,
		integer	ldc,
		integer	iarow,
		integer	iacol,
		integer	icrow,
		integer	iccol,
		complex*16, dimension( * )	work )

Definition at line 1 of file pbztran.f.

*
*  -- PB-BLAS routine (version 2.1) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory.
*     April 28, 1996
*
*     Jaeyoung Choi, Oak Ridge National Laboratory
*     Jack Dongarra, University of Tennessee and Oak Ridge National Lab.
*     David Walker,  Oak Ridge National Laboratory
*
*     .. Scalar Arguments ..
      CHARACTER*1        ADIST, TRANS
      INTEGER            IACOL, IAROW, ICCOL, ICONTXT, ICROW, LDA, LDC,
     $                   M, N, NB
      COMPLEX*16         BETA
*     ..
*     .. Array Arguments ..
      COMPLEX*16         A( LDA, * ), C( LDC, * ), WORK( * )
*     ..
*
*  Purpose
*  =======
*
*  PBZTRAN  transposes  a column block to row block, or a row block to
*  column block by reallocating data distribution.
*
*     C := A^T + beta*C, or C := A^C + beta*C
*
*  where A is an M-by-N matrix  and C is an N-by-M matrix, and the size
*  of M or N is limited to its block size NB.
*
*  The first elements  of the matrices A, and C  should  be  located  at
*  the beginnings of their first blocks. (not the middle of the blocks.)
*
*  Parameters
*  ==========
*
*  ICONTXT (input) INTEGER
*          ICONTXT is the BLACS mechanism for partitioning communication
*          space.  A defining property of a context is that a message in
*          a context cannot be sent or received in another context.  The
*          BLACS context includes the definition of a grid, and each
*          process' coordinates in it.
*
*  ADIST  - (input) CHARACTER*1
*           ADIST specifies whether A is a column block or a row block.
*
*              ADIST = 'C',  A is a column block
*              ADIST = 'R',  A is a row block
*
*  TRANS  - (input) CHARACTER*1
*           TRANS specifies whether the transposed format is transpose
*           or conjugate transpose.  If the matrices A and C are real,
*           the argument is ignored.
*
*              TRANS = 'T',  transpose
*              TRANS = 'C',  conjugate transpose
*
*  M      - (input) INTEGER
*           M specifies the (global) number of rows of the matrix (block
*           column or block row) A and of columns of the matrix C.
*           M >= 0.
*
*  N      - (input) INTEGER
*           N specifies the (global) number of columns of the matrix
*           (block column or block row) A  and of columns of the matrix
*           C.  N >= 0.
*
*  NB     - (input) INTEGER
*           NB specifies  the column block size of the matrix A and the
*           row block size of the matrix C when ADIST = 'C'.  Otherwise,
*           it specifies  the row block size of the matrix A and the
*           column block size of the matrix C. NB >= 1.
*
*  A       (input) COMPLEX*16 array of DIMENSION ( LDA, Lx ),
*          where Lx is N  when ADIST = 'C', or Nq when ADIST = 'R'.
*          Before entry with  ADIST = 'C',  the leading Mp by N part of
*          the array A must contain the matrix A, otherwise the leading
*          M by Nq part of the array A  must contain the matrix A.  See
*          parameter details for the values of Mp and Nq.
*
*  LDA     (input) INTEGER
*          LDA specifies the leading dimension of (local) A as declared
*          in the calling (sub) program.  LDA >= MAX(1,Mp) when
*          ADIST = 'C', or LDA >= MAX(1,M) otherwise.
*
*  BETA    (input) COMPLEX*16
*          BETA specifies scaler beta.
*
*  C       (input/output) COMPLEX*16 array of DIMENSION ( LDC, Lx ),
*          where Lx is Mq when ADIST = 'C', or N when ADIST = 'R'.
*          If ADIST = 'C', the leading N-by-Mq part of the array C
*          contains the (local) matrix C, otherwise the leading
*          Np-by-M part of the array C must contain the (local) matrix
*          C.  C will not be referenced if beta is zero.
*
*  LDC     (input) INTEGER
*          LDC specifies the leading dimension of (local) C as declared
*          in the calling (sub) program. LDC >= MAX(1,N) when ADIST='C',
*          or LDC >= MAX(1,Np) otherwise.
*
*  IAROW   (input) INTEGER
*          IAROW specifies  a row  of the process  template,
*          which holds the first block  of the matrix  A. If A is a row
*          of blocks (ADIST = 'R') and all rows of processes have a copy
*          of A, then set IAROW = -1.
*
*  IACOL   (input) INTEGER
*          IACOL specifies  a column of the process template,
*          which holds  the first block  of the matrix A.  If  A is  a
*          column of blocks (ADIST = 'C') and all columns of processes
*          have a copy of A, then set IACOL = -1.
*
*  ICROW   (input) INTEGER
*          ICROW specifies the current row process which holds
*          the first block  of the matrix C,  which is transposed of A.
*          If C is a row of blocks (ADIST = 'C') and the transposed
*          row block C is distributed all rows of processes, set
*          ICROW = -1.
*
*  ICCOL   (input) INTEGER
*          ICCOL specifies  the current column process which holds
*          the first block of the matrix C,  which is transposed of A.
*          If C is a column of blocks (ADIST = 'R') and the transposed
*          column block C is distributed all columns of processes,
*          set ICCOL = -1.
*
*  WORK    (workspace) COMPLEX*16 array of dimension Size(WORK).
*          It needs extra working space of A'.
*
*  Parameters Details
*  ==================
*
*  Lx      It is  a local portion  of L  owned  by  a process,  (L is
*          replaced by M, or N,  and x is replaced by either p (=NPROW)
*          or q (=NPCOL)).  The value is  determined by  L, LB, x,  and
*          MI, where  LB is  a block size  and  MI is a  row  or column
*          position  in a process template.  Lx is  equal to  or less
*          than Lx0 = CEIL( L, LB*x ) * LB.
*
*  Communication Scheme
*  ====================
*
*  The communication scheme of the routine is set to '1-tree', which is
*  fan-out.  (For details, see BLACS user's guide.)
*
*  Memory Requirement of WORK
*  ==========================
*
*  Mqb  = CEIL( M, NB*NPCOL )
*  Npb  = CEIL( N, NB*NPROW )
*  LCMQ = LCM / NPCOL
*  LCMP = LCM / NPROW
*
*  (1) ADIST = 'C'
*   (a) IACOL != -1
*       Size(WORK) = N * CEIL(Mqb,LCMQ)*NB
*   (b) IACOL = -1
*       Size(WORK) = N * CEIL(Mqb,LCMQ)*NB * MIN(LCMQ,CEIL(M,NB))
*
*  (2) ADIST = 'R'
*   (a) IAROW != -1
*       Size(WORK) = M * CEIL(Npb,LCMP)*NB
*   (b) IAROW = -1
*       Size(WORK) = M * CEIL(Npb,LCMP)*NB * MIN(LCMP,CEIL(N,NB))
*
*  Notes
*  -----
*  More precise space can be computed as
*
*  CEIL(Mqb,LCMQ)*NB => NUMROC( NUMROC(M,NB,0,0,NPCOL), NB, 0, 0, LCMQ )
*  CEIL(Npb,LCMP)*NB => NUMROC( NUMROC(N,NB,0,0,NPROW), NB, 0, 0, LCMP )
*
*  =====================================================================
*
*     ..
*     .. Parameters ..
      COMPLEX*16         ONE, ZERO
      parameter( one  = ( 1.0d+0, 0.0d+0 ),
     $                   zero = ( 0.0d+0, 0.0d+0 ) )
*     ..
*     .. Local Scalars ..
      LOGICAL            COLFORM, ROWFORM
      INTEGER            I, IDEX, IGD, INFO, JCCOL, JCROW, JDEX, LCM,
     $                   LCMP, LCMQ, MCCOL, MCROW, ML, MP, MQ, MQ0,
     $                   MRCOL, MRROW, MYCOL, MYROW, NP, NP0, NPCOL,
     $                   NPROW, NQ
      COMPLEX*16         TBETA
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      INTEGER            ILCM, ICEIL, NUMROC
      EXTERNAL           ilcm, iceil, lsame, numroc
*     ..
*     .. External Subroutines ..
      EXTERNAL           blacs_gridinfo, pbzmatadd, pbztr2af, pbztr2at,
     $                   pbztr2bt, pbztrget, pbztrsrt, pxerbla, zgebr2d,
     $                   zgebs2d, zgerv2d, zgesd2d
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          max, min, mod
*     ..
*     .. Executable Statements ..
*
*     Quick return if possible.
*
      IF( m.EQ.0 .OR. n.EQ.0 ) RETURN
*
      CALL blacs_gridinfo( icontxt, nprow, npcol, myrow, mycol )
*
      colform = lsame( adist, 'C' )
      rowform = lsame( adist, 'R' )
*
*     Test the input parameters.
*
      info = 0
      IF( ( .NOT.colform ) .AND. ( .NOT.rowform ) ) THEN
         info = 2
      ELSE IF( m .LT.0                            ) THEN
         info = 4
      ELSE IF( n .LT.0                            ) THEN
         info = 5
      ELSE IF( nb.LT.1                            ) THEN
         info = 6
      ELSE IF( iarow.LT.-1 .OR. iarow.GE.nprow .OR.
     $       ( iarow.EQ.-1 .AND. colform )        ) THEN
         info = 12
      ELSE IF( iacol.LT.-1 .OR. iacol.GE.npcol .OR.
     $       ( iacol.EQ.-1 .AND. rowform )        ) THEN
         info = 13
      ELSE IF( icrow.LT.-1 .OR. icrow.GE.nprow .OR.
     $       ( icrow.EQ.-1 .AND. rowform )        ) THEN
         info = 14
      ELSE IF( iccol.LT.-1 .OR. iccol.GE.npcol .OR.
     $       ( iccol.EQ.-1 .AND. colform )        ) THEN
         info = 15
      END IF
*
   10 CONTINUE
      IF( info .NE. 0 ) THEN
         CALL pxerbla( icontxt, 'PBZTRAN ', info )
         RETURN
      END IF
*
*     Start the operations.
*
*     LCM : the least common multiple of NPROW and NPCOL
*
      lcm  = ilcm( nprow, npcol )
      lcmp = lcm   / nprow
      lcmq = lcm   / npcol
      igd  = npcol / lcmp
*
*     When A is a column block
*
      IF( colform ) THEN
*
*       Form  C <== A'  ( A is a column block )
*                                         _
*                                        | |
*                                        | |
*            _____________               | |
*           |______C______|     <==      |A|
*                                        | |
*                                        | |
*                                        |_|
*
*       MRROW : row relative position in template from IAROW
*       MRCOL : column relative position in template from ICCOL
*
        mrrow = mod( nprow+myrow-iarow, nprow )
        mrcol = mod( npcol+mycol-iccol, npcol )
        jcrow = icrow
        IF( icrow.EQ.-1 ) jcrow = iarow
*
        mp  = numroc( m, nb, myrow, iarow, nprow )
        mq  = numroc( m, nb, mycol, iccol, npcol )
        mq0 = numroc( numroc(m, nb, 0, 0, npcol), nb, 0, 0, lcmq )
*
        IF( lda.LT.mp .AND.
     $         ( iacol.EQ.mycol .OR. iacol.EQ.-1 ) ) THEN
           info = 8
        ELSE IF( ldc.LT.n .AND.
     $         ( icrow.EQ.myrow .OR. icrow.EQ.-1 ) ) THEN
           info = 11
        END IF
        IF( info.NE.0 ) GO TO 10
*
*       When a column process of IACOL has a column block A,
*
        IF( iacol.GE.0 ) THEN
          tbeta = zero
          IF( myrow.EQ.jcrow ) tbeta = beta
*
          DO 20 i = 0, min( lcm, iceil(m,nb) ) - 1
            mcrow = mod( mod(i, nprow) + iarow, nprow )
            mccol = mod( mod(i, npcol) + iccol, npcol )
            IF( lcmq.EQ.1 )  mq0 = numroc( m, nb, i, 0, npcol )
            jdex = (i/npcol) * nb
*
*           A source node copies the blocks to WORK, and send it
*
            IF( myrow.EQ.mcrow .AND. mycol.EQ.iacol ) THEN
*
*             The source node is a destination node
*
              idex = (i/nprow) * nb
              IF( myrow.EQ.jcrow .AND. mycol.EQ.mccol ) THEN
                CALL pbztr2at( icontxt, 'col', TRANS, MP-IDEX, N, NB,
     $                         A(IDEX+1,1), LDA, TBETA, C(1,JDEX+1),
     $                         LDC, LCMP, LCMQ )
*
*             The source node sends blocks to a destination node
*
              ELSE
                CALL PBZTR2BT( ICONTXT, 'col', TRANS, MP-IDEX, N, NB,
     $                         A(IDEX+1,1), LDA, ZERO, WORK, N,
     $                         LCMP*NB )
                CALL ZGESD2D( ICONTXT, N, MQ0, WORK, N, JCROW, MCCOL )
              END IF
*
*           A destination node receives the copied blocks
*
.EQ..AND..EQ.            ELSE IF( MYROWJCROW  MYCOLMCCOL ) THEN
.EQ..AND..EQ.              IF( LCMQ1  TBETAZERO ) THEN
                CALL ZGERV2D( ICONTXT, N, MQ0, C, LDC, MCROW, IACOL )
              ELSE
                CALL ZGERV2D( ICONTXT, N, MQ0, WORK, N, MCROW, IACOL )
                CALL PBZTR2AF( ICONTXT, 'row', N, MQ-JDEX, NB, WORK, N,
     $                         TBETA, C(1,JDEX+1), LDC, LCMP, LCMQ,
     $                         MQ0 )
              END IF
            END IF
   20     CONTINUE
*
*         Broadcast a row block of C in each column of template
*
.EQ.          IF( ICROW-1 ) THEN
.EQ.            IF( MYROWJCROW ) THEN
              CALL ZGEBS2D( ICONTXT, 'col', '1-tree', N, MQ, C, LDC )
            ELSE
              CALL ZGEBR2D( ICONTXT, 'col', '1-tree', N, MQ, C, LDC,
     $                      JCROW, MYCOL )
            END IF
          END IF
*
*       When all column procesors have a copy of the column block A,
*
        ELSE
.EQ.          IF( LCMQ1 ) MQ0 = MQ
*
*         Processors, which have diagonal blocks of A, copy them to
*         WORK array in transposed form
*
          DO 30 I = 0, LCMP-1
.EQ.            IF( MRCOLMOD( NPROW*I+MRROW, NPCOL ) ) THEN
.EQ..AND..EQ..OR..EQ.              IF( LCMQ1(ICROW-1ICROWMYROW) ) THEN
                 CALL PBZTR2BT( ICONTXT, 'col', TRANS, MP-I*NB, N, NB,
     $                          A(I*NB+1,1), LDA, BETA, C, LDC,
     $                          LCMP*NB )
              ELSE
                 CALL PBZTR2BT( ICONTXT, 'col', TRANS, MP-I*NB, N, NB,
     $                          A(I*NB+1,1), LDA, ZERO, WORK, N,
     $                          LCMP*NB )
              END IF
            END IF
   30     CONTINUE
*
*         Get diagonal blocks of A for each column of the template
*
          MCROW = MOD( MOD(MRCOL,NPROW)+IAROW, NPROW )
.GT.          IF( LCMQ1 ) THEN
            MCCOL = MOD( NPCOL+MYCOL-ICCOL, NPCOL )
            CALL PBZTRGET( ICONTXT, 'row', N, MQ0, ICEIL(M,NB), WORK, N,
     $                     MCROW,  MCCOL, IGD, MYROW, MYCOL, NPROW,
     $                     NPCOL )
          END IF
*
*         Broadcast a row block of WORK in every row of template
*
.EQ.          IF( ICROW-1 ) THEN
.EQ.            IF( MYROWMCROW ) THEN
.GT.              IF( LCMQ1 )
     $          CALL PBZTRSRT( ICONTXT, 'row', N, MQ, NB, WORK, N, BETA,
     $                         C, LDC, LCMP, LCMQ, MQ0 )
              CALL ZGEBS2D( ICONTXT, 'col', '1-tree', N, MQ, C, LDC )
            ELSE
              CALL ZGEBR2D( ICONTXT, 'col', '1-tree', N, MQ, C, LDC,
     $                      MCROW, MYCOL )
            END IF
*
*         Send a row block of WORK to the destination row
*
          ELSE
.EQ.            IF( LCMQ1 ) THEN
.EQ.              IF( MYROWMCROW ) THEN
.NE.                IF( MYROWICROW )
     $            CALL ZGESD2D( ICONTXT, N, MQ, WORK, N, ICROW, MYCOL )
.EQ.              ELSE IF( MYROWICROW ) THEN
.EQ.                IF( BETAZERO ) THEN
                  CALL ZGERV2D( ICONTXT, N, MQ, C, LDC, MCROW, MYCOL )
                ELSE
                  CALL ZGERV2D( ICONTXT, N, MQ, WORK, N, MCROW, MYCOL )
                  CALL PBZMATADD( ICONTXT, 'g', N, MQ, ONE, WORK, N,
     $                            BETA, C, LDC )
                END IF
              END IF
*
            ELSE
              ML = MQ0 * MIN( LCMQ, MAX(0,ICEIL(M,NB)-MCCOL) )
.EQ.              IF( MYROWMCROW ) THEN
.NE.                IF( MYROWICROW )
     $            CALL ZGESD2D( ICONTXT, N, ML, WORK, N, ICROW, MYCOL )
.EQ.              ELSE IF( MYROWICROW ) THEN
                CALL ZGERV2D( ICONTXT, N, ML, WORK, N, MCROW, MYCOL )
              END IF
*
.EQ.              IF( MYROWICROW )
     $          CALL PBZTRSRT( ICONTXT, 'row', N, MQ, NB, WORK, N, BETA,
     $                         C, LDC, LCMP, LCMQ, MQ0 )
            END IF
          END IF
*
        END IF
*
*     When A is a row block
*
      ELSE
*
*        Form  C <== A'  ( A is a row block )
*            _
*           | |
*           | |
*           | |                _____________
*           |C|      <==      |______A______|
*           | |
*           | |
*           |_|
*
*        MRROW : row relative position in template from ICROW
*        MRCOL : column relative position in template from IACOL
*
         MRROW = MOD( NPROW+MYROW-ICROW, NPROW )
         MRCOL = MOD( NPCOL+MYCOL-IACOL, NPCOL )
         JCCOL = ICCOL
.EQ.         IF( ICCOL-1 ) JCCOL = IACOL
*
         NP  = NUMROC( N, NB, MYROW, ICROW, NPROW )
         NQ  = NUMROC( N, NB, MYCOL, IACOL, NPCOL )
         NP0 = NUMROC( NUMROC(N, NB, 0, 0, NPROW), NB, 0, 0, LCMP )
*
.LT..AND.         IF( LDAM 
.EQ..OR..EQ.     $          ( IAROWMYROW  IAROW-1 ) ) THEN
            INFO = 8
.LT..AND.         ELSE IF( LDCNP 
.EQ..OR..EQ.     $          ( ICCOLMYCOL  ICCOL-1 ) ) THEN
            INFO = 11
         END IF
.NE.         IF( INFO0 ) GO TO 10
*
*        When a row process of IAROW has a row block A,
*
.GE.         IF( IAROW0 ) THEN
           TBETA = ZERO
.EQ.           IF( MYCOLJCCOL ) TBETA = BETA
*
           DO 40 I = 0, MIN( LCM, ICEIL(N,NB) ) - 1
             MCROW = MOD( MOD(I, NPROW) + ICROW, NPROW )
             MCCOL = MOD( MOD(I, NPCOL) + IACOL, NPCOL )
.EQ.             IF( LCMP1 )  NP0 = NUMROC( N, NB, I, 0, NPROW )
             IDEX = (I/NPROW) * NB
*
*            A source node copies the blocks to WORK, and send it
*
.EQ..AND..EQ.             IF( MYROWIAROW  MYCOLMCCOL ) THEN
*
*              The source node is a destination node
*
               JDEX = (I/NPCOL) * NB
.EQ..AND..EQ.               IF( MYROWMCROW  MYCOLJCCOL ) THEN
                 CALL PBZTR2AT( ICONTXT, 'row', TRANS, M, NQ-JDEX, NB,
     $                          A(1,JDEX+1), LDA, TBETA, C(IDEX+1,1),
     $                          LDC, LCMP, LCMQ )
*
*              The source node sends blocks to a destination node
*
               ELSE
                 CALL PBZTR2BT( ICONTXT, 'row', TRANS, M, NQ-JDEX, NB,
     $                          A(1,JDEX+1), LDA, ZERO, WORK, NP0,
     $                          LCMQ*NB )
                 CALL ZGESD2D( ICONTXT, NP0, M, WORK, NP0,
     $                         MCROW, JCCOL )
               END IF
*
*           A destination node receives the copied blocks
*
.EQ..AND..EQ.            ELSE IF( MYROWMCROW  MYCOLJCCOL ) THEN
.EQ..AND..EQ.              IF( LCMP1  TBETAZERO ) THEN
                CALL ZGERV2D( ICONTXT, NP0, M, C, LDC, IAROW, MCCOL )
              ELSE
                CALL ZGERV2D( ICONTXT, NP0, M, WORK, NP0, IAROW, MCCOL )
                CALL PBZTR2AF( ICONTXT, 'col', NP-IDEX, M, NB, WORK,
     $                         NP0, TBETA, C(IDEX+1,1), LDC, LCMP, LCMQ,
     $                         NP0 )
              END IF
            END IF
   40     CONTINUE
*
*         Broadcast a column block of WORK in each row of template
*
.EQ.          IF( ICCOL-1 ) THEN
.EQ.            IF( MYCOLJCCOL ) THEN
              CALL ZGEBS2D( ICONTXT, 'row', '1-tree', NP, M, C, LDC )
            ELSE
              CALL ZGEBR2D( ICONTXT, 'row', '1-tree', NP, M, C, LDC,
     $                       MYROW, JCCOL )
            END IF
          END IF
*
*       When all row procesors have a copy of the row block A,
*
        ELSE
.EQ.          IF( LCMP1 ) NP0 = NP
*
*         Processors, which have diagonal blocks of A, copy them to
*         WORK array in transposed form
*
          DO 50 I = 0, LCMQ-1
.EQ.            IF( MRROWMOD(NPCOL*I+MRCOL, NPROW) ) THEN
.EQ..AND..EQ..OR..EQ.              IF( LCMP1(ICCOL-1ICCOLMYCOL) ) THEN
                CALL PBZTR2BT( ICONTXT, 'row', TRANS, M, NQ-I*NB, NB,
     $                         A(1,I*NB+1), LDA, BETA, C, LDC,
     $                         LCMQ*NB )
              ELSE
                CALL PBZTR2BT( ICONTXT, 'row', TRANS, M, NQ-I*NB, NB,
     $                         A(1,I*NB+1), LDA, ZERO, WORK, NP0,
     $                         LCMQ*NB )
              END IF
            END IF
   50     CONTINUE
*
*         Get diagonal blocks of A for each row of the template
*
          MCCOL = MOD( MOD(MRROW, NPCOL)+IACOL, NPCOL )
.GT.          IF( LCMP1 ) THEN
            MCROW = MOD( NPROW+MYROW-ICROW, NPROW )
            CALL PBZTRGET( ICONTXT, 'col', NP0, M, ICEIL(N,NB), WORK,
     $                     NP0, MCROW, MCCOL, IGD, MYROW, MYCOL, NPROW,
     $                     NPCOL )
          END IF
*
*         Broadcast a column block of WORK in every column of template
*
.EQ.          IF( ICCOL-1 ) THEN
.EQ.            IF( MYCOLMCCOL ) THEN
.GT.              IF( LCMP1 )
     $          CALL PBZTRSRT( ICONTXT, 'col', np, m, nb, work, np0,
     $                         beta, c, ldc, lcmp, lcmq, np0 )
              CALL zgebs2d( icontxt, 'Row', '1-tree', np, m, c, ldc )
            ELSE
              CALL zgebr2d( icontxt, 'row', '1-tree', NP, M, C, LDC,
     $                       MYROW, MCCOL )
            END IF
*
*         Send a column block of WORK to the destination column
*
          ELSE
.EQ.            IF( LCMP1 ) THEN
.EQ.              IF( MYCOLMCCOL ) THEN
.NE.                IF( MYCOLICCOL )
     $            CALL ZGESD2D( ICONTXT, NP, M, WORK, NP, MYROW, ICCOL )
.EQ.              ELSE IF( MYCOLICCOL ) THEN
.EQ.                IF( BETAZERO ) THEN
                  CALL ZGERV2D( ICONTXT, NP, M, C, LDC, MYROW, MCCOL )
                ELSE
                  CALL ZGERV2D( ICONTXT, NP, M, WORK, NP, MYROW, MCCOL )
                  CALL PBZMATADD( ICONTXT, 'g', NP, M, ONE, WORK, NP,
     $                            BETA, C, LDC )
                END IF
              END IF
*
            ELSE
              ML = M * MIN( LCMP, MAX( 0, ICEIL(N,NB) - MCROW ) )
.EQ.              IF( MYCOLMCCOL ) THEN
.NE.                IF( MYCOLICCOL )
     $            CALL ZGESD2D( ICONTXT, NP0, ML, WORK, NP0,
     $                          MYROW, ICCOL )
.EQ.              ELSE IF( MYCOLICCOL ) THEN
                CALL ZGERV2D( ICONTXT, NP0, ML, WORK, NP0,
     $                        MYROW, MCCOL )
              END IF
*
.EQ.              IF( MYCOLICCOL )
     $          CALL PBZTRSRT( ICONTXT, 'col', NP, M, NB, WORK, NP0,
     $                         BETA, C, LDC, LCMP, LCMQ, NP0 )
            END IF
          END IF
*
        END IF
      END IF
*
      RETURN
*
*     End of PBZTRAN
*