SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
pbdtrst1.f
Go to the documentation of this file.
1 SUBROUTINE pbdtrst1( ICONTXT, XDIST, N, NB, NZ, X, INCX, BETA, Y,
2 $ INCY, LCMP, LCMQ, NINT )
3*
4* -- PB-BLAS routine (version 2.1) --
5* University of Tennessee, Knoxville, Oak Ridge National Laboratory.
6* April 28, 1996
7*
8* .. Scalar Arguments ..
9 CHARACTER*1 XDIST
10 INTEGER ICONTXT, INCX, INCY, LCMP, LCMQ, N, NB, NINT,
11 $ nz
12 DOUBLE PRECISION BETA
13* ..
14* .. Array Arguments ..
15 DOUBLE PRECISION X( * ), Y( * )
16* ..
17*
18* Purpose
19* =======
20*
21* PBDTRST1 forms y <== x + beta * y, where y is a sorted
22* condensed row (or column) vector from a column (or row) vector of x.
23*
24* =====================================================================
25*
26* .. Parameters ..
27 DOUBLE PRECISION ONE
28 parameter( one = 1.0d+0 )
29* ..
30* .. Local Variables ..
31 INTEGER ITER, IX, IY, K, KK, KZ, NJUMP
32* ..
33* .. External Subroutines ..
34 EXTERNAL pbdvecadd
35* ..
36* .. External Functions ..
37 LOGICAL LSAME
38 INTEGER ICEIL
39 EXTERNAL iceil, lsame
40* ..
41* .. Intrinsic Functions ..
42 INTRINSIC min, max, mod
43* ..
44* .. Executable Statements ..
45*
46 iter = iceil( nint, nb )
47 kz = nz
48*
49 IF( lsame( xdist, 'R' ) ) THEN
50 njump = nb * lcmq
51*
52 DO 20 kk = 0, lcmq-1
53 ix = nint * mod( kk*lcmp, lcmq )
54 iy = max( 0, nb*kk-nz )
55 IF( n.LT.iy ) GO TO 50
56*
57 IF( iter.GT.1 ) THEN
58 CALL pbdvecadd( icontxt, 'G', nb-kz, one, x(ix*incx+1),
59 $ incx, beta, y(iy*incy+1), incy )
60 ix = ix + nb - kz
61 iy = iy + njump - kz
62 kz = 0
63*
64 DO 10 k = 2, iter-1
65 CALL pbdvecadd( icontxt, 'G', nb, one, x(ix*incx+1),
66 $ incx, beta, y(iy*incy+1), incy )
67 ix = ix + nb
68 iy = iy + njump
69 10 CONTINUE
70 END IF
71*
72 CALL pbdvecadd( icontxt, 'G', min(nb-kz,n-iy), one,
73 $ x(ix*incx+1), incx, beta, y(iy*incy+1),
74 $ incy )
75 kz = 0
76 20 CONTINUE
77*
78* if( LSAME( XDIST, 'C' ) ) then
79*
80 ELSE
81 njump = nb * lcmp
82*
83 DO 40 kk = 0, lcmp-1
84 ix = nint * mod( kk*lcmq, lcmp )
85 iy = max( 0, nb*kk-nz )
86 IF( n.LT.iy ) GO TO 50
87*
88 IF( iter.GT.1 ) THEN
89 CALL pbdvecadd( icontxt, 'G', nb-kz, one, x(ix*incx+1),
90 $ incx, beta, y(iy*incy+1), incy )
91 ix = ix + nb - kz
92 iy = iy + njump - kz
93 kz = 0
94*
95 DO 30 k = 2, iter-1
96 CALL pbdvecadd( icontxt, 'G', nb, one, x(ix*incx+1),
97 $ incx, beta, y(iy*incy+1), incy )
98 ix = ix + nb
99 iy = iy + njump
100 30 CONTINUE
101 END IF
102*
103 CALL pbdvecadd( icontxt, 'G', min(nb-kz,n-iy), one,
104 $ x(ix*incx+1), incx, beta, y(iy*incy+1),
105 $ incy )
106 kz = 0
107 40 CONTINUE
108 END IF
109*
110 50 CONTINUE
111*
112 RETURN
113*
114* End of PBDTRST1
115*
116 END
subroutine pbdtrst1(icontxt, xdist, n, nb, nz, x, incx, beta, y, incy, lcmp, lcmq, nint)
Definition pbdtrst1.f:3
subroutine pbdvecadd(icontxt, mode, n, alpha, x, incx, beta, y, incy)
Definition pbdvecadd.f:3
#define max(A, B)
Definition pcgemr.c:180
#define min(A, B)
Definition pcgemr.c:181