d3/dcc/pbztrget_8f_source.html

00001       SUBROUTINE PBZTRGET( ICONTXT, ADIST, M, N, MNB, A, LDA, MCROW,
00002      $                     MCCOL, IGD, MYROW, MYCOL, NPROW, NPCOL )
00003 *
00004 *  -- PB-BLAS routine (version 2.1) --
00005 *     University of Tennessee, Knoxville, Oak Ridge National Laboratory.
00006 *     April 28, 1996
00007 *
00008 *     .. Scalar Arguments ..
00009       CHARACTER*1        ADIST
00010       INTEGER            ICONTXT, IGD, LDA, M, MCCOL, MCROW, MNB, MYCOL,
00011      $                   MYROW, N, NPCOL, NPROW
00012 *     ..
00013 *     .. Array Arguments ..
00014       COMPLEX*16         A( LDA, * )
00015 *     ..
00016 *
00017 *  Purpose
00018 *  =======
00019 *
00020 *  PBZTRGET forms a row block of A from scattered row subblocks if
00021 *  ADIST = 'R', or forms a column block of A from scattered column
00022 *  subblocks,  if ADIST = 'C'.
00023 *
00024 *  =====================================================================
00025 *
00026 *     .. Parameters ..
00027       REAL               ONE, TWO
00028       PARAMETER          ( ONE = 1.0E+0, TWO = 2.0E+0 )
00029 *     ..
00030 *     .. Local Variables ..
00031       INTEGER            KINT, KINT2, KLEN, KMOD, KPPOS, NLEN, NNUM,
00032      $                   NTLEN
00033       REAL               TEMP
00034 *     ..
00035 *     .. External Functions ..
00036       LOGICAL            LSAME
00037       INTEGER            ICEIL, NUMROC
00038       EXTERNAL           LSAME,  ICEIL, NUMROC
00039 *     ..
00040 *     .. External Subroutines ..
00041       EXTERNAL           ZGERV2D, ZGESD2D
00042 *     ..
00043 *     .. Intrinsic Functions ..
00044       INTRINSIC          MAX, MIN, MOD
00045 *
00046 *     if A is a row block, it needs to communicate columnwise.
00047 *
00048       IF( LSAME( ADIST, 'R' ) ) THEN
00049          KPPOS = MOD( NPROW+MYROW-MCROW, NPROW )
00050          IF( MOD( KPPOS, IGD ).EQ.0 ) THEN
00051             KINT = IGD
00052             NLEN = N
00053             NNUM = MIN( NPROW/IGD, MNB-MCCOL )
00054             TEMP = REAL( NNUM )
00055             NTLEN = N * NNUM
00056             NNUM = IGD * NNUM
00057             IF( KPPOS.GE.NNUM ) GO TO 30
00058             KPPOS = MOD( KPPOS, NPROW )
00059 *
00060    10       CONTINUE
00061             IF( TEMP.GT.ONE ) THEN
00062                KINT2 = 2 * KINT
00063                KMOD = MOD( KPPOS, KINT2 )
00064 *
00065                IF( KMOD.EQ.0 ) THEN
00066                   IF( KPPOS+KINT.LT.NNUM ) THEN
00067                      KLEN = NTLEN - (KPPOS/KINT2)*(KINT2/IGD)*N
00068                      KLEN = MIN( KLEN-NLEN, NLEN )
00069                      CALL ZGERV2D( ICONTXT, M, KLEN, A(1,NLEN+1), LDA,
00070      $                             MOD(MYROW+KINT, NPROW), MYCOL )
00071                      NLEN = NLEN + KLEN
00072                   END IF
00073                ELSE
00074                   CALL ZGESD2D( ICONTXT, M, NLEN, A, LDA,
00075      $                          MOD(NPROW+MYROW-KINT, NPROW), MYCOL )
00076                   GO TO 30
00077                END IF
00078 *
00079                KINT = KINT2
00080                TEMP = TEMP / TWO
00081                GO TO 10
00082             END IF
00083          END IF
00084 *
00085 *     if A is a column block, it needs to communicate rowwise.
00086 *
00087       ELSE IF( LSAME( ADIST, 'C' ) ) THEN
00088 *
00089          KPPOS = MOD( NPCOL+MYCOL-MCCOL, NPCOL )
00090          IF( MOD( KPPOS, IGD ).EQ.0 ) THEN
00091             KINT = IGD
00092             NLEN = N
00093             NNUM = MIN( NPCOL/IGD, MNB-MCROW )
00094             TEMP = REAL( NNUM )
00095             NTLEN = N * NNUM
00096             NNUM = IGD * NNUM
00097             IF( KPPOS.GE.NNUM ) GO TO 30
00098             KPPOS = MOD( KPPOS, NPCOL )
00099 *
00100    20       CONTINUE
00101             IF( TEMP.GT.ONE ) THEN
00102                KINT2 = 2 * KINT
00103                KMOD = MOD( KPPOS, KINT2 )
00104 *
00105                IF( KMOD.EQ.0 ) THEN
00106                   IF( KPPOS+KINT.LT.NNUM ) THEN
00107                      KLEN = NTLEN - (KPPOS/KINT2)*(KINT2/IGD)*N
00108                      KLEN = MIN( KLEN-NLEN, NLEN )
00109                      CALL ZGERV2D( ICONTXT, M, KLEN, A(1,NLEN+1), LDA,
00110      $                             MYROW, MOD(MYCOL+KINT, NPCOL) )
00111                      NLEN = NLEN + KLEN
00112                   END IF
00113                ELSE
00114                   CALL ZGESD2D( ICONTXT, M, NLEN, A, LDA, MYROW,
00115      $                          MOD(NPCOL+MYCOL-KINT, NPCOL) )
00116                   GO TO 30
00117                END IF
00118 *
00119                KINT = KINT2
00120                TEMP = TEMP / TWO
00121                GO TO 20
00122             END IF
00123          END IF
00124       END IF
00125 *
00126    30 CONTINUE
00127 *
00128       RETURN
00129 *
00130 *     End of PBZTRGET
00131 *
00132       END