1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
SUBROUTINE PBCTRST1( ICONTXT, XDIST, N, NB, NZ, X, INCX, BETA, Y,
$ INCY, LCMP, LCMQ, NINT )
*
* -- 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
COMPLEX BETA
* ..
* .. Array Arguments ..
COMPLEX X( * ), Y( * )
* ..
*
* Purpose
* =======
*
* PBCTRST1 forms y <== x + beta * y, where y is a sorted
* condensed row (or column) vector from a column (or row) vector of x.
*
* =====================================================================
*
* .. Parameters ..
COMPLEX ONE
PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
* ..
* .. Local Variables ..
INTEGER ITER, IX, IY, K, KK, KZ, NJUMP
* ..
* .. External Subroutines ..
EXTERNAL PBCVECADD
* ..
* .. 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 PBCVECADD( 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 PBCVECADD( 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 PBCVECADD( 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 )
IF( N.LT.IY ) GO TO 50
*
IF( ITER.GT.1 ) THEN
CALL PBCVECADD( 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 PBCVECADD( 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 PBCVECADD( 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 PBCTRST1
*
END
|
