3
4
5
6
7
8
9 CHARACTER*1 XDIST
10 INTEGER ICONTXT, INCX, INCY, LCMP, LCMQ, N, NB, NINT,
11 $ NZ
12 DOUBLE PRECISION BETA
13
14
15 DOUBLE PRECISION X( * ), Y( * )
16
17
18
19
20
21
22
23
24
25
26
27 DOUBLE PRECISION ONE
28 parameter( one = 1.0d+0 )
29
30
31 INTEGER ITER, IX, IY, K, KK, KZ, NJUMP
32
33
35
36
37 LOGICAL LSAME
38 INTEGER ICEIL
40
41
43
44
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
73 $ x(ix*incx+1), incx, beta, y(iy*incy+1),
74 $ incy )
75 kz = 0
76 20 CONTINUE
77
78
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
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
115
integer function iceil(inum, idenom)
subroutine pbdvecadd(icontxt, mode, n, alpha, x, incx, beta, y, incy)