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
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
SUBROUTINE PBDTRGET( ICONTXT, ADIST, M, N, MNB, A, LDA, MCROW,
$ MCCOL, IGD, MYROW, MYCOL, NPROW, NPCOL )
*
* -- PB-BLAS routine (version 2.1) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory.
* April 28, 1996
*
* .. Scalar Arguments ..
CHARACTER*1 ADIST
INTEGER ICONTXT, IGD, LDA, M, MCCOL, MCROW, MNB, MYCOL,
$ MYROW, N, NPCOL, NPROW
* ..
* .. Array Arguments ..
DOUBLE PRECISION A( LDA, * )
* ..
*
* Purpose
* =======
*
* PBDTRGET forms a row block of A from scattered row subblocks if
* ADIST = 'R', or forms a column block of A from scattered column
* subblocks, if ADIST = 'C'.
*
* =====================================================================
*
* .. Parameters ..
REAL ONE, TWO
PARAMETER ( ONE = 1.0E+0, TWO = 2.0E+0 )
* ..
* .. Local Variables ..
INTEGER KINT, KINT2, KLEN, KMOD, KPPOS, NLEN, NNUM,
$ NTLEN
REAL TEMP
* ..
* .. External Functions ..
LOGICAL LSAME
INTEGER ICEIL, NUMROC
EXTERNAL LSAME, ICEIL, NUMROC
* ..
* .. External Subroutines ..
EXTERNAL DGERV2D, DGESD2D
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN, MOD
*
* if A is a row block, it needs to communicate columnwise.
*
IF( LSAME( ADIST, 'R' ) ) THEN
KPPOS = MOD( NPROW+MYROW-MCROW, NPROW )
IF( MOD( KPPOS, IGD ).EQ.0 ) THEN
KINT = IGD
NLEN = N
NNUM = MIN( NPROW/IGD, MNB-MCCOL )
TEMP = REAL( NNUM )
NTLEN = N * NNUM
NNUM = IGD * NNUM
IF( KPPOS.GE.NNUM ) GO TO 30
KPPOS = MOD( KPPOS, NPROW )
*
10 CONTINUE
IF( TEMP.GT.ONE ) THEN
KINT2 = 2 * KINT
KMOD = MOD( KPPOS, KINT2 )
*
IF( KMOD.EQ.0 ) THEN
IF( KPPOS+KINT.LT.NNUM ) THEN
KLEN = NTLEN - (KPPOS/KINT2)*(KINT2/IGD)*N
KLEN = MIN( KLEN-NLEN, NLEN )
CALL DGERV2D( ICONTXT, M, KLEN, A(1,NLEN+1), LDA,
$ MOD(MYROW+KINT, NPROW), MYCOL )
NLEN = NLEN + KLEN
END IF
ELSE
CALL DGESD2D( ICONTXT, M, NLEN, A, LDA,
$ MOD(NPROW+MYROW-KINT, NPROW), MYCOL )
GO TO 30
END IF
*
KINT = KINT2
TEMP = TEMP / TWO
GO TO 10
END IF
END IF
*
* if A is a column block, it needs to communicate rowwise.
*
ELSE IF( LSAME( ADIST, 'C' ) ) THEN
*
KPPOS = MOD( NPCOL+MYCOL-MCCOL, NPCOL )
IF( MOD( KPPOS, IGD ).EQ.0 ) THEN
KINT = IGD
NLEN = N
NNUM = MIN( NPCOL/IGD, MNB-MCROW )
TEMP = REAL( NNUM )
NTLEN = N * NNUM
NNUM = IGD * NNUM
IF( KPPOS.GE.NNUM ) GO TO 30
KPPOS = MOD( KPPOS, NPCOL )
*
20 CONTINUE
IF( TEMP.GT.ONE ) THEN
KINT2 = 2 * KINT
KMOD = MOD( KPPOS, KINT2 )
*
IF( KMOD.EQ.0 ) THEN
IF( KPPOS+KINT.LT.NNUM ) THEN
KLEN = NTLEN - (KPPOS/KINT2)*(KINT2/IGD)*N
KLEN = MIN( KLEN-NLEN, NLEN )
CALL DGERV2D( ICONTXT, M, KLEN, A(1,NLEN+1), LDA,
$ MYROW, MOD(MYCOL+KINT, NPCOL) )
NLEN = NLEN + KLEN
END IF
ELSE
CALL DGESD2D( ICONTXT, M, NLEN, A, LDA, MYROW,
$ MOD(NPCOL+MYCOL-KINT, NPCOL) )
GO TO 30
END IF
*
KINT = KINT2
TEMP = TEMP / TWO
GO TO 20
END IF
END IF
END IF
*
30 CONTINUE
*
RETURN
*
* End of PBDTRGET
*
END
|
