pbstrst1.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	pbstrst1 (icontxt, xdist, n, nb, nz, x, incx, beta, y, incy, lcmp, lcmq, nint)

Function/Subroutine Documentation

pbstrst1()

subroutine pbstrst1	(	integer	icontxt,
		character*1	xdist,
		integer	n,
		integer	nb,
		integer	nz,
		real, dimension( * )	x,
		integer	incx,
		real	beta,
		real, dimension( * )	y,
		integer	incy,
		integer	lcmp,
		integer	lcmq,
		integer	nint )

Definition at line 1 of file pbstrst1.f.

*
*  -- 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
      REAL               BETA
*     ..
*     .. Array Arguments ..
      REAL               X( * ), Y( * )
*     ..
*
*  Purpose
*  =======
*
*  PBSTRST1 forms  y <== x + beta * y, where y is a sorted
*  condensed row (or column) vector from a column (or row) vector of x.
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ONE
      parameter( one = 1.0e+0 )
*     ..
*     .. Local Variables ..
      INTEGER            ITER, IX, IY, K, KK, KZ, NJUMP
*     ..
*     .. External Subroutines ..
      EXTERNAL           pbsvecadd
*     ..
*     .. 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 pbsvecadd( 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 pbsvecadd( 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 pbsvecadd( 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 pbsvecadd( 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 pbsvecadd( 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 pbsvecadd( 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 PBSTRST1
*