ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
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
pbdvecadd
subroutine pbdvecadd(ICONTXT, MODE, N, ALPHA, X, INCX, BETA, Y, INCY)
Definition: pbdvecadd.f:3
max
#define max(A, B)
Definition: pcgemr.c:180
pbdtrst1
subroutine pbdtrst1(ICONTXT, XDIST, N, NB, NZ, X, INCX, BETA, Y, INCY, LCMP, LCMQ, NINT)
Definition: pbdtrst1.f:3
min
#define min(A, B)
Definition: pcgemr.c:181