pbctrst1.f

Go to the documentation of this file.

      SUBROUTINE pbctrst1( ICONTXT, XDIST, N, NB, NZ, X, INCX, BETA, Y,
     $                     INCY, LCMP, LCMQ, NINT )
*
*  -- PB-BLAS routine (version 2.1) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory.
*     April 28, 1996
*
*     .. Scalar Arguments ..
      CHARACTER*1        XDIST
      INTEGER            ICONTXT, INCX, INCY, LCMP, LCMQ, N, NB, NINT,
     $                   nz
      COMPLEX            BETA
*     ..
*     .. Array Arguments ..
      COMPLEX            X( * ), Y( * )
*     ..
*
*  Purpose
*  =======
*
*  PBCTRST1 forms  y <== x + beta * y, where y is a sorted
*  condensed row (or column) vector from a column (or row) vector of x.
*
*  =====================================================================
*
*     .. Parameters ..
      COMPLEX            ONE
      parameter( one  = ( 1.0e+0, 0.0e+0 ) )
*     ..
*     .. Local Variables ..
      INTEGER            ITER, IX, IY, K, KK, KZ, NJUMP
*     ..
*     .. External Subroutines ..
      EXTERNAL           pbcvecadd
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      INTEGER            ICEIL
      EXTERNAL           iceil, lsame
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          min, max, mod
*     ..
*     .. Executable Statements ..
*
      iter = iceil( nint,  nb )
      kz   = nz
*
      IF( lsame( xdist, 'R' ) ) THEN
         njump = nb * lcmq
*
         DO 20 kk = 0, lcmq-1
            ix = nint * mod( kk*lcmp, lcmq )
            iy = max( 0, nb*kk-nz )
            IF( n.LT.iy ) GO TO 50
*
            IF( iter.GT.1 ) THEN
               CALL pbcvecadd( icontxt, 'G', nb-kz, one, x(ix*incx+1),
     $                         incx, beta, y(iy*incy+1), incy )
               ix = ix + nb - kz
               iy = iy + njump - kz
               kz = 0
*
               DO 10 k = 2, iter-1
                  CALL pbcvecadd( icontxt, 'G', nb, one, x(ix*incx+1),
     $                            incx, beta, y(iy*incy+1), incy )
                  ix = ix + nb
                  iy = iy + njump
   10          CONTINUE
            END IF
*
            CALL pbcvecadd( icontxt, 'G', min(nb-kz,n-iy), one,
     $                      x(ix*incx+1), incx, beta, y(iy*incy+1),
     $                      incy )
            kz = 0
   20    CONTINUE
*
*     if( LSAME( XDIST, 'C' ) ) then
*
      ELSE
         njump = nb * lcmp
*
         DO 40 kk = 0, lcmp-1
            ix = nint * mod( kk*lcmq, lcmp )
            iy = max( 0, nb*kk-nz )
            IF( n.LT.iy ) GO TO 50
*
            IF( iter.GT.1 ) THEN
               CALL pbcvecadd( icontxt, 'G', nb-kz, one, x(ix*incx+1),
     $                         incx, beta, y(iy*incy+1), incy )
               ix = ix + nb - kz
               iy = iy + njump - kz
               kz = 0
*
               DO 30 k = 2, iter-1
                  CALL pbcvecadd( icontxt, 'G', nb, one, x(ix*incx+1),
     $                            incx, beta, y(iy*incy+1), incy )
                  ix = ix + nb
                  iy = iy + njump
   30          CONTINUE
            END IF
*
            CALL pbcvecadd( icontxt, 'G', min(nb-kz,n-iy), one,
     $                      x(ix*incx+1), incx, beta, y(iy*incy+1),
     $                      incy )
            kz = 0
   40    CONTINUE
      END IF
*
   50 CONTINUE
*
      RETURN
*
*     End of PBCTRST1
*
      END