df/d13/pbdtrst1_8f_source.html

00001       SUBROUTINE PBDTRST1( ICONTXT, XDIST, N, NB, NZ, X, INCX, BETA, Y,
00002      $                     INCY, LCMP, LCMQ, NINT )
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        XDIST
00010       INTEGER            ICONTXT, INCX, INCY, LCMP, LCMQ, N, NB, NINT,
00011      $                   NZ
00012       DOUBLE PRECISION   BETA
00013 *     ..
00014 *     .. Array Arguments ..
00015       DOUBLE PRECISION   X( * ), Y( * )
00016 *     ..
00017 *
00018 *  Purpose
00019 *  =======
00020 *
00021 *  PBDTRST1 forms  y <== x + beta * y, where y is a sorted
00022 *  condensed row (or column) vector from a column (or row) vector of x.
00023 *
00024 *  =====================================================================
00025 *
00026 *     .. Parameters ..
00027       DOUBLE PRECISION   ONE
00028       PARAMETER          ( ONE = 1.0D+0 )
00029 *     ..
00030 *     .. Local Variables ..
00031       INTEGER            ITER, IX, IY, K, KK, KZ, NJUMP
00032 *     ..
00033 *     .. External Subroutines ..
00034       EXTERNAL           PBDVECADD
00035 *     ..
00036 *     .. External Functions ..
00037       LOGICAL            LSAME
00038       INTEGER            ICEIL
00039       EXTERNAL           ICEIL, LSAME
00040 *     ..
00041 *     .. Intrinsic Functions ..
00042       INTRINSIC          MIN, MAX, MOD
00043 *     ..
00044 *     .. Executable Statements ..
00045 *
00046       ITER = ICEIL( NINT,  NB )
00047       KZ   = NZ
00048 *
00049       IF( LSAME( XDIST, 'R' ) ) THEN
00050          NJUMP = NB * LCMQ
00051 *
00052          DO 20 KK = 0, LCMQ-1
00053             IX = NINT * MOD( KK*LCMP, LCMQ )
00054             IY = MAX( 0, NB*KK-NZ )
00055             IF( N.LT.IY ) GO TO 50
00056 *
00057             IF( ITER.GT.1 ) THEN
00058                CALL PBDVECADD( ICONTXT, 'G', NB-KZ, ONE, X(IX*INCX+1),
00059      $                         INCX, BETA, Y(IY*INCY+1), INCY )
00060                IX = IX + NB - KZ
00061                IY = IY + NJUMP - KZ
00062                KZ = 0
00063 *
00064                DO 10 K = 2, ITER-1
00065                   CALL PBDVECADD( ICONTXT, 'G', NB, ONE, X(IX*INCX+1),
00066      $                            INCX, BETA, Y(IY*INCY+1), INCY )
00067                   IX = IX + NB
00068                   IY = IY + NJUMP
00069    10          CONTINUE
00070             END IF
00071 *
00072             CALL PBDVECADD( ICONTXT, 'G', MIN(NB-KZ,N-IY), ONE,
00073      $                      X(IX*INCX+1), INCX, BETA, Y(IY*INCY+1),
00074      $                      INCY )
00075             KZ = 0
00076    20    CONTINUE
00077 *
00078 *     if( LSAME( XDIST, 'C' ) ) then
00079 *
00080       ELSE
00081          NJUMP = NB * LCMP
00082 *
00083          DO 40 KK = 0, LCMP-1
00084             IX = NINT * MOD( KK*LCMQ, LCMP )
00085             IY = MAX( 0, NB*KK-NZ )
00086             IF( N.LT.IY ) GO TO 50
00087 *
00088             IF( ITER.GT.1 ) THEN
00089                CALL PBDVECADD( ICONTXT, 'G', NB-KZ, ONE, X(IX*INCX+1),
00090      $                         INCX, BETA, Y(IY*INCY+1), INCY )
00091                IX = IX + NB - KZ
00092                IY = IY + NJUMP - KZ
00093                KZ = 0
00094 *
00095                DO 30 K = 2, ITER-1
00096                   CALL PBDVECADD( ICONTXT, 'G', NB, ONE, X(IX*INCX+1),
00097      $                            INCX, BETA, Y(IY*INCY+1), INCY )
00098                   IX = IX + NB
00099                   IY = IY + NJUMP
00100    30          CONTINUE
00101             END IF
00102 *
00103             CALL PBDVECADD( ICONTXT, 'G', MIN(NB-KZ,N-IY), ONE,
00104      $                      X(IX*INCX+1), INCX, BETA, Y(IY*INCY+1),
00105      $                      INCY )
00106             KZ = 0
00107    40    CONTINUE
00108       END IF
00109 *
00110    50 CONTINUE
00111 *
00112       RETURN
00113 *
00114 *     End of PBDTRST1
00115 *
00116       END