pbdtrst1.f File Reference

Go to the source code of this file.

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

Function/Subroutine Documentation

pbdtrst1()

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

Definition at line 1 of file pbdtrst1.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
      DOUBLE PRECISION   BETA
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION   X( * ), Y( * )
*     ..
*
*  Purpose
*  =======
*
*  PBDTRST1 forms  y <== x + beta * y, where y is a sorted
*  condensed row (or column) vector from a column (or row) vector of x.
*
*  =====================================================================
*
*     .. Parameters ..
      DOUBLE PRECISION   ONE
      parameter( one = 1.0d+0 )
*     ..
*     .. Local Variables ..
      INTEGER            ITER, IX, IY, K, KK, KZ, NJUMP
*     ..
*     .. External Subroutines ..
      EXTERNAL           pbdvecadd
*     ..
*     .. 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 pbdvecadd( 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 pbdvecadd( 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 PBDVECADD( 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 )
.LT.            IF( NIY ) GO TO 50
*
.GT.            IF( ITER1 ) THEN
               CALL PBDVECADD( 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 PBDVECADD( 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 PBDVECADD( 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 PBDTRST1
*